COMMENT ⊗   VALID 00043 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002
C00005 00003
C00009 00004
C00012 00005
C00015 00006
C00018 00007
C00020 00008
C00022 00009
C00023 00010
C00028 00011
C00029 00012
C00032 00013
C00035 00014
C00039 00015
C00042 00016
C00045 00017
C00047 00018
C00053 00019
C00056 00020
C00058 00021
C00061 00022
C00063 00023
C00066 00024
C00069 00025
C00072 00026
C00074 00027
C00076 00028
C00079 00029
C00083 00030
C00087 00031
C00090 00032
C00092 00033
C00094 00034
C00096 00035
C00100 00036
C00104 00037
C00106 00038
C00108 00039
C00110 00040
C00112 00041
C00114 00042
C00116 00043
C00118 ENDMK
C⊗;

;;;   **************************************************************
;;;   ***** MACLISP ****** GARBAGE COLLECTOR AND ALLOCATION STUFF **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************




	PGBOT GC


SUBTTL	GRABBAGE COLLECTORS AND RELATED ITEMS


GCRET:	TDZA A,A	;GC WITH NORET=NIL
GCNRT:	MOVEI A,TRUTH	;GC WITH NORET=T
	HRRI T,UNBIND	;EXPECTS FLAG IN LH OF T
	PUSH P,T
	JSP T,SPECBIND
	0 A,VNORET
	JRST AGC


GC:	PUSH P,[333333,,FALSE]	;SUBR 0 - USER ENTRY TO GC
	JRST AGC		;TO UNDERSTAND THE 3'S, SEE GSTRT7


MINCEL==6*NFF	;MIN NUMBER WORDS TO RECLAIM FOR EACH SPACE
IFG 40-MINCEL, MINCEL==40

GCCNT:
OFFSET -.
	NIL		;SO THAT THE FOLLOWING INS WILL STOP ON NIL
GCCNT1:	SKIPE TT,(TT)
GCCNT4:	AOJA GCCNT0,.-1	;OR MAYBE AOBJN
LPROG3==.
	JRST GCP4A
GCCNT0:
OFFSET 0
.HKILL GCCNT1 GCCNT4 GCCNT0


;;; *********** GARBAGE COLLECTOR **********

SUBTTL	GC - INITIALIZATION

WHL==USELESS*QIO*ITS

   XCTPRO
AGC4:	HRROS NOQUIT
   NOPRO
	SUBI A,2	;ENTRY FROM FWCONS,FPCONS
	PUSH P,A
   XCTPRO
AGC:	HRROS NOQUIT
   NOPRO
	SKIPE ALGCF	;CANT SUCCESSFULLY GC WHILE IN ALLOC
	 JRST ALERR
AGC1:		;MUST HAVE DONE  HRROS NOQUIT  BEFORE COMING HERE
10%	.SUSET [.RRUNT,,GCTM1]
	MOVEM NACS+1,GCNASV
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,		;GET RUNTIME IN MILLSECS.
10$	MOVEM NACS+1,GCTM1
	MOVE NACS+1,[UUOH,,GCUUSV]
	BLT NACS+1,GCUUSV+LUUSV-1	;SAVE UUOH STUFF, IN CASE STRT IS USED
	MOVE NACS+1,[NACS+2,,GCNASV+1]
	BLT NACS+1,GCNASV+17-<NACS+1>	;SAVE NON-MARKED AC'S
	MOVEI NACS+1,GCACSAV
	BLT NACS+1,GCACSAV+NACS	;BLT AWAY ARG ACS (AND NIL) INTO PROTECTED PLACE
Q$	SETZM GCFXP
	SETZ R,
REPEAT NFF,[
	SKIPN FFS+.RPCNT	;FIGURE OUT WHICH SPACE(S) EMPTY
	 TLO R,400000←-.RPCNT
]		;END OF REPEAT NFF
	SKIPN FFY2		;IF WE RAN OUT OF SYMBOL BLOCKS,
	 TLO R,400000←<-FFY+FFS>	; THEN CREDIT IT TO SYMBOLS
	MOVN D,R		;THIS IS A STANDARD HACK TO KILL ONE BIT
	TDZE R,D		;SKIP IF THERE WERE NO BITS
	 JUMPE R,GCGRAB		;JUMP IF EXACTLY ONE BIT ON
AGC1Q:	SETZM GCRMV
	AOSE IRMVF	;IF OVERRIDE IS ON, THEN
	 SKIPE VGCTWA
	  SETOM GCRMV		;DO REMOVAL ANYHOW.
	MOVNI TT,20		;TOP 40 BITS OF WORD ON
	JSP F,GCINBT		;INIT MARK BITS FOR LIST, FIXNUM, ETC.
	MOVE T,[SFSSIZ,,OFSSIZ]	;SAVE AWAY OLD SIZES OF SPACES
	BLT T,OSASIZ		; (USED FOR ARG TO GC-DAEMON)
	MOVE T,VGCDAEMON
	IOR T,GCGAGV
IFE WHL,	JUMPE T,GCP6
IFN WHL,	JUMPE T,GCP5
	MOVSI R,GCCNT
	BLT R,LPROG3
	SKIPN VGCDAEMON
	HRLI GCCNT4,(AOBJN GCCNT0,)
	MOVNI R,NFF		;MAY OR MAY NOT HAVE BIGNUMS OR HUNKS
GCP4:	SETZ GCCNT0,
	SKIPGE FFS+NFF(R)
	 JRST GCP4B
	SKIPN VGCDAEMON
	MOVSI GCCNT0,-MINCEL
	SKIPE TT,FFS+NFF(R)
	AOJA GCCNT0,GCCNT1
GCP4A:	TLZ GCCNT0,-1
	HRRZ F,GCWORN+NFF(R)	;ACCOUNT FOR LENGTHS OF ITEMS
	IMULI GCCNT0,(F)
	CAIGE GCCNT0,MINCEL
	SETZM FFS+NFF(R)
GCP4B:	HRLM GCCNT0,NFFS+NFF(R)
	AOJL R,GCP4

;FALLS THROUGH

;FALLS IN

;;;	PDLS ARE SAFE

IFN WHL,[
GCP5:	MOVE F,GCWHO
	SKIPE GCGAGV
	JRST GSTRT0
	TRNN F,1
	JRST GCP6
	JRST GSTR0A
]		;END OF IFN WHL
IFE WHL,[
	SKIPN GCGAGV
	 JRST GCP6
]		;END OF IFE WHL
GSTRT0:	STRT 17,[SIXBIT \↑M;GC DUE TO !\]
GSTR0A:	SETZB TT,D		;FIGURE OUT REASON FOR GC
	HLRZ T,(P)
	CAIN T,111111		;WAS IT INITIAL STARTUP? (SEE LISP)
	 MOVEI TT,[SIXBIT \STARTUP!\]
	CAIN T,333333		;WAS IT USER CALLING GC FUNCTION?
	 MOVEI TT,[SIXBIT \USER!\]
	CAIN T,444444		;WAS IT ARRAYS?
	 MOVEI TT,[SIXBIT \ARRAY RELOCATION!\]
Q$	CAIN T,555555		;I/O CHANNELS?
Q$	 MOVEI TT,[SIXBIT \I/O CHANNELS!\]
	JUMPN TT,GSTRT8
	MOVNI T,NFF		;NONE OF THOSE HYPOTHESES WORK
GSTRT1:	SKIPN FFS+NFF(T)	;MAYBE SOME STORAGE SPACE RAN OUT
	 SKIPA TT,T
	  ADDI D,1
	AOJL T,GSTRT1
	JUMPE TT,GSTRT7		;NO, THAT WASN'T IT
IFN WHL,	SKIPN GCGAGV
.ALSO,		 JRST GSTRT6
	MOVNI T,NFF		;YES, IT WAS. PRINT MOBY MESSAGE!
	SETZ R,
GSTRT2:	SKIPE FFS+NFF(T)
	 JRST GSTRT5
	JUMPE R,GSTRT3
	CAIE D,NFF-2
	 STRT 17,[SIXBIT \, !\]
	CAMN T,TT
	 STRT 17,[SIXBIT \ AND !\]
GSTRT3:	SETO R,
	STRT 17,@GSTRT9+NFF(T)
GSTRT5:	AOJL T,GSTRT2
	STRT 17,[SIXBIT \ SPACE!\]
	CAIE D,NFF-1
	 STRT 17,[SIXBIT \S!\]
IFN WHL,	MOVE TT,GSTRT9+NFF(TT)
	JRST GSTRT6


GSTRT7:	MOVEI TT,[SIXBIT \ ? !\]	;I DON'T KNOW WHY WE'RE HERE!
GSTRT8:
IFN WHL,SKIPE GCGAGV
	STRT 17,(TT)		;PRINT REASON

GSTRT6:
IFN WHL,[
	TRNN F,1
	 JRST GCWHL9
	MOVE D,(TT)
	MOVE R,1(TT)
	ROTC D,-22
	MOVSI F,(SIXBIT \!\)
	MOVE T,[220600,,D]
GCWHL2:	ILDB TT,T
	CAIE TT,'!
	 JRST GCWHL2
	DPB NIL,T
GCWHL3:	IDPB NIL,T
	TLNE T,770000
	 JRST GCWHL3
	HRLI D,(SIXBIT \GC:\)
	MOVE T,[-6,,GCWHL6]
	.SUSET T
	MOVEI T,40
	.SUPSET T,
GCWHL9:
]		;END OF IFN WHL

;FALLS THROUGH

;;;	 PDLS ARE SAFE

SUBTTL	GC - MARK THE WORLD

;FALLS IN

GCP6:	HRROS MUNGP		;STARTING TO MUNG SYMBOL/SAR MARK BITS
	MOVE A,[<-20>←-NUNMRK]	;PRE-PROTECT CERTAIN
	ANDM A,BTBLKS		; RANDOM LIST CELLS
	MOVNI R,NACS+1		;PROTECT CONTENTS OF MARKED ACS
GCP6Q0:	HRRZ A,GCACSAV+NACS+1(R)
	JSP T,GCMARK
	AOJL R,GCP6Q0
	HRRZ R,C2
	ADDI R,1
GCP6Q1:	HRRZ A,(R)		;CAUSES MARKING OF CONTENTS
	JSP T,GCMARK		;OF ACS AT TIME OF GC, AND OF REG PDL
	CAIGE R,(P)
	AOJA R,GCP6Q1
	MOVEI R,LPROTE-1
GCP6Q2:	MOVEI A,BPROTE(R)	;PROTECT PRECIOUS STUFF
	JSP T,GCMARK
	SOJGE R,GCP6Q2
IFN BIGNUM,[
	MOVEI R,LBIGPRO-1
GCP6Q3:	MOVEI A,BBIGPRO(R)
	JSP T,GCMARK
	SOJGE R,GCP6Q3
]		;END OF IFN BIGNUM
	MOVSI R,TTS<GC>
	IORM R,DEDSAR+TTSAR	;PROTECT DEDSAR
	IORM R,UB.AC+TTSAR	;PROTECT "UNBOUND" ARRAY SAR
	IORM R,DBM+TTSAR	;PROTECT DEAD BLOCK MARKER
	HRRZ R,SC2
GCP6Q4:	HRRZ A,(R)
	JSP T,GCMARK		;MARK SAVED VALUES ON SPEC PDL
	CAIGE R,(SP)
	AOJA R,GCP6Q4
	SKIPN R,INTAR
	JRST GCP6Q6
GCP6Q5:	MOVE A,INTAR(R)
	JSP T,GCMARK
	SOJG R,GCP6Q5
GCP6Q6:				;PROTECT INTERRUPT FUNCTIONS
IFE QIO,[
	MOVEI R,LUINTTB-1
GCP6Q7:	SKIPE A,@UINTTB(R)
	JSP T,GCMARK
	SOJGE R,GCP6Q7
]		;END OF IFE QIO
IFN QIO,[
IRP Z,,[0,1,2]X,,[ALARMCLOCK,AUTFN,UDF]
	MOVEI R,NUINT!Z
	SKIPE A,V!X(R)
	JSP T,GCMARK
	SOJG R,.-2
TERMIN
	SKIPE A,VMERR
	 JSP T,GCMARK
]		;END OF IFN QIO
	SKIPN GCRMV
	JRST GCP6B1
	JSP R,GCGEN		;IF DOING TWA REMOVAL, TRY MARKING FROM 
		GCP8I		;NON-TRIVIAL P-LISTS OF CURRENT OBARRAY
	JRST GCP6B2

;;;	PDLS ARE SAFE

GCP6B1:	MOVE A,VOBARRAY
	JSP TT,$GCMKAR		;OTHERWISE, JUST MARK OBARRAY BUCKETS
GCP6B2:	MOVEI A,OBARRAY
	CAME A,VOBARRAY
	 JSP TT,$GCMKAR
	MOVE R,GCMKL
GCP6A:	JUMPE R,GCP6D
	HLRZ A,(R)
	MOVE D,ASAR(A)
	TLNN D,AS<GCP>	;IF ARRAY POINTER HAS "GC ME" BIT SET,
	 JRST GCP6F
	TLNE D,AS<OBA>	;MORE CHECKING ON OBARRAYS
	 JRST GCP6F0
GCP6F1:	JSP TT,GCMKAR	; THEN MARK FROM ARRAY ENTRIES
GCP6F:	HRRZ R,(R)
	HRRZ R,(R)
	JRST GCP6A

GCP6F0:	CAMN A,VOBARRAY	; AND IF THIS ISN'T THE CURRENT OBARRAY,
	 SKIPN GCRMV	; OR IT IS, BUT WE ARENT DOING GCTWA REMOVAL,
	  JRST GCP6F1
	JRST GCP6F

GCP6D:
IFN QIO,[
	MOVE A,V%TYI
	JSP TT,$GCMKAR
	MOVE A,V%TYO
	JSP TT,$GCMKAR
]		;END OF IFN QIO
	SKIPN R,PROLIS
GCP6D1:	 JUMPE R,GCP6H	;PROTECT READ-MACRO
	HLRZ A,(R)	; FUNCTIONS (CAN'T JUST GCMARK WHOLE
	HLRZ A,(A)	; PROLIS - DON'T WANT TO PROTECT
	JSP T,GCMARK	; READTABLE SARS)
	HRRZ R,(R)
	JRST GCP6D1



GSTRT9:	[SIXBIT \LIST!\]		;ALSO USED BY GCWORRY
	[SIXBIT \FIXNUM!\]
	[SIXBIT \FLONUM!\]
IFN BIGNUM, [SIXBIT \BIGNUM!\]
	[SIXBIT \SYMBOL!\]
IRP X,,[4,8,16,32,64,128,256,512,1024]
IFE .IRPCNT-HNKLOG, .ISTOP
	[SIXBIT \HUNK!X!!\]
TERMIN
	[SIXBIT \ARRAY!\]

IFN WHL,[
GCWHL6:	.RWHO1,,GCWHO1
	.RWHO2,,GCWHO2
	.RWHO3,,GCWHO3
	.SWHO1,,[.BYTE 8?66?0?366?0?.BYTE]
	.SWHO2,,D
	.SWHO3,,R
]	;IFN WHL

;;;	PDLS ARE SAFE

SUBTTL	GC - CONSIDER THE EFFECTS OF AN ARRAY DISAPPEARING

;;; UPDATE THE GCMKL BY SPLICING OUT ARRAYS TO BE SWEPT.
;;; IF ANY SUCH ARRAYS ARE OPEN FILES, CLOSE THEM.

CGCMKL:
GCP6H:	SKIPN F,GCMKL
	JRST GCP7
	JSP A,GCP6H0
GCP6H1:	HLRZ A,(F)
	TDNE TT,TTSAR(A)
	JRST GCP6G
Q$	TDNE T,ASAR(A)
Q$	JRST GCP6H7
Q$ GCP6H8:
	ANDCAM TT,TTSAR(A)
	IORM R,TTSAR(A)
	MOVEI B,ADEAD
	EXCH B,ASAR(A)
	TLNN B,AS<RDT>
	JRST GCP6G
	MOVEI AR1,PROLIS	;JUST KILLED A READTABLE
GCP6H3:	HRRZ AR2A,(AR1)		; - CLEAN UP PROLIS
GCP6H4:	JUMPE AR2A,GCP6G
	HLRZ C,(AR2A)
	HRRZ C,(C)
	HLRZ C,(C)
	CAIE C,(A)
	JRST GCP6H5
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)
	JRST GCP6H4
GCP6H5:	MOVEI AR1,(AR2A)
	JRST GCP6H3
GCP6G:	HRRZ F,(F)
	HRRZ F,(F)
	JUMPN F,GCP6H1
	JRST GCP7

GCP6H0:	MOVSI T,AS<JOB+FIL>	;SET UP SOME ACS FOR THE GCMKL-LOOK LOOP
	MOVE R,[TTDEAD]
	MOVSI TT,TTS<CN+GC>
	JRST (A)

;;;	PDLS ARE SAFE


IFN QIO,[

;;; CLEAN UP AND CLOSE A FILE WHEN GARBAGE COLLECTED

GCP6H7:	MOVE B,TTSAR(A)		;ABOUT TO GC A FILE ARRAY
	TLNE B,TTS<CL>		;IGNORE IF ALREADY CLOSED
	 JRST GCP6H8
	PUSH P,F
IFN JOBQIO,[
	HLL B,ASAR(A)
	TLNE B,AS<JOB>
	 JRST GCP6J1
]		;END OF IFN JOBQIO
	PUSHJ P,ICLOSE		;OTHERWISE CLOSE THE FILE
	MOVEI R,[SIXBIT \↑M;FILE CLOSED: !\]
GCP6H2:	SKIPN GCGAGV
	 JRST GCP6H9
	STRT 17,(R)
	HLRZ A,@(P)
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	HRROI R,$TYO
	PUSHJ P,PRINTA
GCP6H9:	POP P,F
	JSP A,GCP6H0		;RE-INIT MAGIC CONSTANTS IN ACS
	HLRZ A,(F)
	JRST GCP6H8



IFN JOBQIO,[

;;; CLEAN UP AND CLOSE AN INFERIOR PROCEDURE WHEN GARBAGE COLLECTED

GCP6J1:	MOVEI R,[SIXBIT \↑M;FOREIGN JOB FLUSHED: !\]
	SKIPN T,J.INTB(B)
	 JRST GCP6J3
	MOVEI R,[SIXBIT \↑M;INFERIOR JOB FLUSHED: !\]
	.CALL GCP6J9
	 .VALUE
	.UCLOSE TMPC,
	JFFO T,.+1
	MOVNS TT
	SETZM JOBTB+21(TT)
GCP6J3:	MOVSI T,TTS<CL>
	ANDCAM T,TTSAR(A)
	JRST GCP6H2

GCP6J9:	SETZ
	SIXBIT \OPEN\		;OPEN FILE (INFERIOR PROCEDURE)
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,F.DEV(B)	;DEVICE NAME (USR)
	      ,,F.FN1(B)	;FILE NAME 1 (UNAME)
	400000,,F.FN2(B)	;FILE NAME 2 (JNAME)

]		;END OF IFN JOBQIO

]		;END OF IFN QIO

;;;	PDLS ARE SAFE

SUBTTL	GC - TWA REMOVAL

GCP7:	HRRZ A,GCMKL
	JSP T,GCMARK
	HRRZ A,PROLIS
	JSP T,GCMARK
	SKIPN GCRMV
	JRST GCSWP
	JSP R,GCGEN		;IF DOING TWA REMOVAL, THEN WIPE OUT
	   GCP8G		; T.W.A.'S AND THEN MARK BUCKETS
	MOVE A,VOBARRAY
	JSP TT,$GCMKAR

;FALLS THROUGH

;;;	PDLS ARE UNSAFE

SUBTTL	GC - SWEEP THE WORLD

;FALLS IN

GCSWP:				.SEE KLINIT ;WHICH CLOBBERS NEXT INSTRUCTION
Q$	MOVEM FXP,GCFXP
	MOVSI FXP,GCFSSWP	;RELOCATE INNER LOOP TO AC'S.
	BLT FXP,LPROG1		;FOR FS SWEEP.
	MOVNI SP,3+BIGNUM	;SWEEP UP THREE OR FOUR FREELISTS
	MOVEM SP,GC99
GCSWP1:	TRZ GFSCNT,-1		;ZERO COUNT FOR THIS LIST
	SETZ P,			;FREELIST ENDS IN NIL
	SKIPN SP,FSSGLK+3+BIGNUM(SP)	;GET PAGE # OF FIRST PAGE OF THIS TYPE
	 JRST GCSWP4
GCSWP2:	MOVEM SP,GC98
	MOVE FLP,GCST(SP)	;GET ADDRESS OF BIT TABLE
	LSH FLP,SEGLOG-5	;LSH TO PROPER PLACE
	HRLI FLP,-BTBSIZ	;<BTBSIZ> WORDS OF BITS
	LSH SP,SEGLOG		;GET ACTUAL PAGE ADDRESS
	HRLI SP,-40		;40 CELLS PER BIT WORD
	JRST GFSP1		;***SWEEP!***
GCSWP3:	MOVE SP,GC98
	LDB SP,[SEGBYT,,GCST(SP)]	;FIND PAGE # OF NEXT PAGE
	JUMPN SP,GCSWP2		;JUMP UNLESS NO MORE
GCSWP4:	AOS SP,GC99
	MOVEM P,FFS+3+BIGNUM-1(SP)	;SAVE FREE LIST
	HRRM GFSCNT,NFFS+3+BIGNUM-1(SP)	;SAVE COUNT OF CELLS RECLAIMED
	JUMPL SP,GCSWP1		;GO DO NEXT KIND OF SPACE IF ANY
GCSW4A:	MOVSI SP,GSYMSWP	;SYMBOL SPACE HAS A SPECIAL SWEEPER
	BLT SP,LPROG6
	MOVE SP,SYSGLK
GCSWP6:	JUMPE SP,GCSWP7
	MOVEI FLP,(SP)
	LSH FLP,SEGLOG
	HRLI FLP,-SEGSIZ
	LDB SP,[SEGBYT,,GCST(SP)]
	JRST GYSP1
GCSWP7:	HRRZM GYSP8,FFY
	HRRM GYCNT,NFFY
IFN HNKLOG,[
	MOVSI SP,GHNKSWP	;HUNK SWEEPER
	BLT SP,LPROGH
	MOVEI SP,HNKLOG
	MOVEM SP,GC99		;GC99 COUNTS VARIOUS HUNK SIZES
GCSWH1:	TRZ GHCNT,-1		;CLEAR COUNT OF HUNKS
	SETZ P,			;CLEAR FREELIST
	SKIPN SP,HNSGLK-1(SP)
	 JRST GCSWH4
	MOVEI FXP,1		;CALCULATE VARIOUS PARAMETERS
	LSH FXP,@GC99		; FOR SWEEPER
	HRRI GHSP4,(FXP)	.SEE GHNKSWP
	SUBI FXP,1
	HRRI GHSP5,(FXP)
	LSH FXP,-5
	HRRI GHSP7,(FXP)
	MOVN FLP,GC99
	MOVNI FXP,40
	LSH FXP,(FLP)
	HRRI GHSP6,(FXP)
GCSWH2:	MOVEM SP,GC98
	MOVE FLP,GCST(SP)	;SET UP AOBJN POINTER TO BIT BLOCKS
	LSH FLP,SEGLOG-5
	HRLI FLP,-BTBSIZ
	LSH SP,SEGLOG		;SET UP AOBJN POINTER TO SWEEP SPACE
	HRLI SP,(GHSP6)
	JRST GHSP1		;***** SWEEP! *****
GCSWH3:	MOVE SP,GC98
	LDB SP,[SEGBYT,,GCST(SP)]
	JUMPN SP,GCSWH2		;MAYBE HACK NEXT SEGMENT OF SAME SIZE HUNKS
GCSWH4:	SOS SP,GC99
	HRRM P,FFH-1+1(SP)	;DON'T DISTURB FFH SIGN BIT!
	MOVEI P,(GHCNT)
	LSH P,1(SP)		;ACCOUNT FOR SIZE OF HUNKS
	HRRM P,NFFH-1+1(SP)
	JUMPG SP,GCSWH1
]		;END OF IFN HNKLOG
	MOVSI SP,GSARSWP	;SAR SPACE HAS A SPECIAL SWEEPER
	BLT SP,LPROG4
	MOVE SP,SASGLK
GCSWP8:	JUMPE SP,GCSWP9
	MOVEI FXP,(SP)
	LSH FXP,SEGLOG
	HRLI FXP,-SEGSIZ/2
	LDB SP,[SEGBYT,,GCST(SP)]
	JRST GSSP1
GCSWP9:	HRRZM GSSP9,FFA
	LSH GSCNT,1		;ACCOUNT FOR SIZE OF SARS
	HRRM GSCNT,NFFA
	HRRZS MUNGP
	MOVSI F,TTS<CN+GC>
	ANDCAM F,DEDSAR		;MUST CLEAR BITS IN DEDSAR
	JSP T,GCACR

;FALLS THROUGH

;;; PDLS ARE SAFE

SUBTTL	GC - MAKE SURE ENOUGH WAS RECLAIMED

;FALLS IN

	SKIPN GCGAGV
	 JRST GCE0
	SETZM GC99		;GC99 COUNTS ENTRIES PRINTED
	MOVNI F,NFF
GCPNT1:	HRRZ T,NFFS+NFF(F)
	SKIPN TT,SFSSIZ+NFF(F)
	 JRST GCPNT6
	SOSLE GC99
	 JRST GCPNT2
	STRT 17,[SIXBIT \↑M; !\]	;TERPRI-; EVERY THIRD ONE
	MOVEI D,3
	MOVEM D,GC99
GCPNT2:	PUSHJ P,STGPNT
	STRT 17,@GCPNT9+NFF(F)
GCPNT6:	AOJL F,GCPNT1

;FALLS THROUGH

;;;	PDLS ARE SAFE

SUBTTL	GC - CLEANUP AND TERMINATION

;FALLS IN

GCE0:	MOVNI F,NFF
GCE0C0:	MOVE AR2A,MFFS+NFF(F)
	TLNN AR2A,-1
	 JRST GCE0C1
	HRRZ AR1,SFSSIZ+NFF(F)
	FSC AR1,233		;FIXNUM TO FLONUM CONVERSION
	FMPR AR1,AR2A
	MULI AR1,400		;FLONUM TO FIXNUM CONVERSION
	ASH AR2A,-243(AR1)
GCE0C1:	SKIPGE FFS+NFF(F)
	 JRST GCE0C5
	CAIGE AR2A,MINCEL
	 MOVEI AR2A,MINCEL	;MUST SATISFY ABSOLUTE MIN OF<MINCEL> CELLS
GCE0C5:	MOVEM AR2A,ZFFS+NFF(F)
	HRRZ TT,NFFS+NFF(F)
	CAIGE TT,(AR2A)		;ALSO MUST SATISFY USER'S MIN
	 PUSHJ P,GCWORRY		;IF NOT, MUST WORRY ABOUT IT
GCE0C2:	AOJL F,GCE0C0
	MOVEI AR2A,1
	SKIPN FFY2
	 PUSHJ P,GRABWORRY	;REMEMBER, F IS ZERO HERE
	SKIPN FFY2
	 JRST GCLUZ
	MOVNI F,NFF		;IF WE RECLAIMED LESS THAN ABSOLUTE
GCE0C3:	HRRZ TT,NFFS+NFF(F)	; MINIMUM FOR ANY SPACE,
	SKIPGE FFS+NFF(F)
	 JRST GCE0C9
	CAIGE TT,MINCEL		; WE ARE OFFICIALLY DEAD
	 JRST GCLUZ
GCE0C9:	AOJL F,GCE0C3
	SKIPE PANICP
	 JRST GCE0C7
	MOVNI F,NFF	;NOW SEE IF WE EXCEEDED MAXIMUM
GCE0C6:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)
	 JRST GCE0K3
Q$	HRLZ D,GCMES+NFF(F)
Q$	HRRI D,1004		;GC-OVERFLOW
Q%	HRLZ A,GCMES+NFF(F)
Q%	HRRI A,13.		;GC-OVERFLOW
	PUSHJ P,UINT		;NOQUIT SET, SO INTERRUPT GETS STACKED
GCE0K3:	AOJL F,GCE0C6
GCE0C7:	MOVNI F,NFF
GCE0C4:	MOVE TT,SFSSIZ+NFF(F)
	CAMG TT,XFFS+NFF(F)	;IF A SPACE LOST TO GC-OVERFLOW,
	 JRST GCE0K2		; DON'T MAKE IT LOSE FOR GC-LOSSAGE TOO
	MOVEM TT,XFFS+NFF(F)	;JUST QUIETLY UPDATE ITS GCMAX
	JRST GCE0K1

GCE0K2:	HRRZ T,NFFS+NFF(F)
	CAMGE T,ZFFS+NFF(F)
	 JRST GCMLOSE
GCE0K1:	AOJL F,GCE0C4
IFE D10,[
	HRRZ TT,NOQUIT
	IOR TT,INHIBIT
	IOR TT,VNORET
	SKIPN TT
	PUSHJ P,RETSP
]		;END OF IFE D10
	SKIPE GCGAGV
	 STRT 17,STRTCR
;FALLS THROUGH

;;; PDLS ARE SAFE

;FALLS IN

	SKIPN VGCDAEMON
	 JRST GCEND
	MOVEI C,NIL		;CONS UP ARG FOR GCDAEMON
	MOVEI D,NFF-1		;WE CHECKED LENGTH OF FREELISTS SO
	SETZ C,			; WE KNOW CONSES WON'T RE-INVOKE GC
GCE0E:	MOVE TT,SFSSIZ(D)	;SIZE OF SPACE AFTER GC
	PUSHJ P,CONS1FX
	MOVE TT,OFSSIZ(D)	;SIZE OF SPACE BEFORE GC
	PUSHJ P,CONSFX
	HRRZ TT,NFFS(D)		;LENGTH OF FREELIST AFTER GC
	CAIN D,FFX-FFS		;ALLOW FOR THE SPACE USED
	 SUBI TT,4*NFF		; TO CONS UP THE GC-DAEMON ARG
	CAIN D,FFS-FFS
	 SUBI TT,6*NFF
	PUSHJ P,CONSFX
	HLRZ TT,NFFS(D)		;LENGTH OF FREELIST BEFORE GC
	PUSHJ P,CONSFX
	HRRZ A,GCMES(D)		;NAME OF SPACE
	PUSHJ P,CONS
	MOVE B,C
	PUSHJ P,CONS
	MOVE C,A
	SOJGE D,GCE0E
	JSR GCRSR		.SEE GCRSR0
IFE QIO,[
	HRLI A,20.		;INT NUMBER OF GC-DAEMON
	PUSH P,A		;FOR GC PROTECTION ONLY
	MOVSS A
	PUSHJ P,UINT
	JRST S1PAJ
]		;END OF IFE QIO
IFN QIO,[
	HRLI A,1003		;GC-DAEMON
	PUSH P,A		;FOR INTERRUPT PROTECTION ONLY
	PUSH FXP,D
	MOVS D,A
	PUSHJ P,UINT
	POP FXP,D
	JRST S1PAJ
]		;END OF IFN QIO

GCPNT9:	[SIXBIT \LIST, !\]
	[SIXBIT \FIXNUM, !\]
	[SIXBIT \FLONUM, !\]
BG$	[SIXBIT \BIGNUM, !\]
	[SIXBIT \SYMBOL, !\]
IRP X,,[4,8,16,32,64,128,256,512,1024]
IFE .IRPCNT-HNKLOG, .ISTOP
	[SIXBIT \HUNK!X, !\]
TERMIN
	[SIXBIT \ARRAY WORDS FREE!\]


;;; GC MUST EITHER JRST TO GCEND, OR JSR TO GCRSR BEFORE EXITING.
;;; THIS ASSURES THAT GCTIM WILL PROPERLY REFLECT TIME SPENT IN GC.

GCEND:	JSP NACS+1,GCACR
Q$	SETZM GCFXP
10%	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]				;IFN WHL
	MOVE NACS+1,GCNASV
	HRRZS NOQUIT
	JRST CHECKI

;GCRSR:	0
GCRSR0:	HRLM C,NOQUIT		;RESTORE ACS, AND CHECK FOR ANY
	JSP NACS+1,GCACR	;DELAYED INTERRUPTS
Q$	SETZM GCFXP
10%	.SUSET [.RRUNT,,NACS+1]
10$	SETZ NACS+1,
10$	RUNTIM NACS+1,
IFN WHL,	MOVEM NACS+1,GC98
	SUB NACS+1,GCTM1
	ADDM NACS+1,GCTIM	;UPDATE GCTIME FOR (STATUS GCTIME)
IFN WHL,[
	SKIPE NACS+1,GCWHO
	PUSHJ P,GCWHR
]				;IFN WHL
	MOVE NACS+1,GCNASV
	PUSH P,A
	HLRZ A,NOQUIT
	PUSH P,GCRSR
	HRRZS NOQUIT
	JRST CHECKI

;;; ROUTINE TO INIT MARK BITS FOR LIST, FIXNUM, FLONUM, HUNK,
;;; AND BIGNUM SPACES. INIT BITS IN TT, RETURN ADDRESS IN F.

GCINBT:	MOVEM TT,BBITSG
	MOVE AR2A,[BBITSG,,BBITSG+1]
	BLT AR2A,@MAINBITBLT	;BLT OUT MAIN BIT AREA
	MOVE A,BTSGLK		;INITIALIZE ALL BIT BLOCKS
GCINB0:	JUMPE A,(F)
	MOVEI AR2A,(A)
	LSH AR2A,SEGLOG		;GET ADDRESS OF SEGMENT
	HRLI AR2A,(AR2A)
	MOVEM TT,(AR2A)
	AOJ AR2A,
	MOVE T,GCST(A)		;GET END ADDRESS FOR BLT
	LSH T,SEGLOG-5
	TLZ T,-1
	CAIE T,(AR2A)
	BLT AR2A,-1(T)		;***BLT!***
	LDB A,[SEGBYT,,GCST(A)]
	JRST GCINB0

IFN WHL,[
GCWHR:	TRNN NACS+1,2
	JRST GCWHR2
	MOVE NACS+2,GCTIM
	IDIVI NACS+2,25000./4
	MOVEM NACS+2,GCWHO2
	MOVE NACS+2,GCTIM
	IMULI NACS+2,100.
	IDIV NACS+2,GC98
	HRLM NACS+2,GCWHO2
	TRNE NACS+1,1
	JRST GCWHR2
	.SUSET [.SWHO2,,GCWHO2]
GCWHR8:	MOVE NACS+2,GCNASV+1
	MOVE NACS+3,GCNASV+2
	POPJ P,
GCWHR2:	MOVE NACS+2,[-3,,GCWHR9]
	.SUSET NACS+2
	MOVEI NACS+2,40
	.SUPSET NACS+2,
	JRST GCWHR8

GCWHR9:	.SWHO1,,GCWHO1
	.SWHO2,,GCWHO2
	.SWHO3,,GCWHO3
]	;IFN WHL


SUBTTL	MISCELLANEOUS GC UTILITY ROUTINES

GCACR:
Q$	SKIPN GCFXP
Q$	 MOVEM FXP,GCFXP
	MOVE NIL,[GCACSAV+1,,1]	;RESTORE ALL ACS EXCEPT NACS+1
	BLT NIL,NACS
	MOVE NIL,[GCNASV+1,,NACS+2]
	BLT NIL,17
	MOVE NIL,GCACSAV
Q$	SETZM GCFXP		.SEE CHNINT	;ETC.
	JRST (NACS+1)


$GCMKAR:	MOVE D,ASAR(A)
GCMKAR:
Q$	MOVE F,TTSAR(A)
	SKIPL D,-1(D)	;MARK FROM ARRAY ENTRIES.
	JRST (TT)
GCMKA1:	HLRZ A,(D)
	JSP T,GCMARK
	HRRZ A,(D)
	JSP T,GCMARK
	AOBJN D,GCMKA1
Q%	JRST (TT)
IFN QIO,[
	JUMPE F,(TT)
	TLNE F,TTS<TY>
	TLNE F,TTS<IO>
	JRST (TT)
	MOVEI D,FB.BUF(F)	;FOR TTY INPUT FILE ARRAYS,
	HRLI D,-NASCII/2	; MUST MARK INTERRUPT FUNCTIONS
	SETZ F,
	JRST GCMKA1
]		;END OF IFN QIO

;;; GCGEN GENERATES NON-NULL BUCKETS OF THE CURRENT OBARRAY
;;; AND APPLIES A GIVEN FUNCTION TO THEM. IT IS CALLED AS
;;;		JSP R,GCGEN
;;;		   FOO
;;; GCGEN WILL EFFECTIVELY DO A  JRST FOO  MANY TIMES,
;;; PASSING SOME NON-NULL OBARRAY BUCKET THROUGH ACCUMULATOR D.
;;; FOO IS EXPECTED TO RETURN BY DOING A  JRST GCP8A.
;;; WHEN DONE, GCGEN RETURNS, SKIPPING OVER THE ADDRESS FOO.

GCGEN:	MOVE F,@VOBARRAY	.SEE ASAR
	MOVE F,-1(F)
	SUB F,R70+1
	TLZ R,400000
GCP8A:	TLCE R,400000
	JRST GCP8A1
	AOBJP F,1(R)	;EXIT
	HLRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A
GCP8A1:	HRRZ D,(F)
	JUMPN D,@(R)
	JRST GCP8A


GSARSWP:			;SPECIAL SWEEPER FOR SARS
OFFSET -.
GSSP0:	ADDI FXP,1
GSSP1:	TDNN GSSP8,TTSAR(FXP)	;TEST IF SAR MARKED
	AOJA GSCNT,GSSP2	;NO, COUNT IT AS SWEPT
	ANDCAM GSSP7,TTSAR(FXP)	;YES, TURN OFF MARK BIT
	AOBJN FXP,GSSP0		; AND TRY NEXT ONE
	JRST GCSWP8
GSSP2:	HRRZM GSSP9,ASAR(FXP)	;CHAIN INTO FREE LIST
	HRRZI GSSP9,ASAR(FXP)
	AOBJN FXP,GSSP0
	JRST GCSWP8
GSSP7:	TTS<GC>,,
GSSP8:	TTS<CN+GC>,,
GSSP9:	NIL
GSCNT:	0
LPROG4==.-1
OFFSET 0
.HKILL GSSP0 GSSP1 GSSP2 GSSP7 GSSP8 GSSP9 GSCNT


GCFSSWP:			;FS SWEEPER, RELOCATED TO ACS
OFFSET -.
GFSP1:	SKIPN FXP,(FLP)		;GET A WORD OF MARK BITS
	JRST GFSP5		;IF ALL 40 WORDS MARKED, THIS SAVES TIME
GFSP2:	JUMPGE FXP,GFSP4	;JUMP IF SINGLE WORD MARKED
	HRRZM P,(SP)		;ELSE CHAIN INTO FREE LIST
	HRRZI P,(SP)
GFSCNT:	AOJ .,0			;RH COUNTS RECLAIMED CELLS
GFSP4:	ROT FXP,1		;ROTATE NEXT MARK BIT UP
	AOBJN SP,GFSP2		;COUNT OFF 40 WORDS
	TLOA SP,-40		;RESET 40-WORD COUNT IN AOBJN POINTER
GFSP5:	ADDI SP,40		;SKIP OVER 40 WORDS IN SWEEP
	AOBJN FLP,GFSP1		;<BTBSIZ> BLOCKS OF 40 WORDS
	JRST GCSWP3
LPROG1==.-1
OFFSET 0
.HKILL GFSP1 GFSP2 GFSCNT GFSP4 GFSP5


IFN HNKLOG,[

GHNKSWP:
OFFSET -.
GHSP1:	MOVE FXP,(FLP)
GHSP2:	JUMPGE FXP,GHSP4
	HRRZM P,(SP)
	HRRZI P,(SP)
GHCNT:	AOJ .,0
GHSP4:	ROT FXP,1←HNKLOG
GHSP5:	ADDI SP,<1←HNKLOG>-1
	AOBJN SP,GHSP2
GHSP6:	TLO SP,<-40>←-HNKLOG
GHSP7:	ADDI FLP,<<1←HNKLOG>-1>←-5
	AOBJN FLP,GHSP1
	JRST GCSWH3
LPROGH==.-1
OFFSET 0
.HKILL GHSP1 GHSP2 GHCNT GHSP4 GHSP5 GHSP6 GHSP7

]		;END OF IFN HNKLOG



GSYMSWP:			;SWEEPER FOR SYMBOL SPACE
OFFSET -.
GYSP8:	NIL		;LH ALWAYS ZERO (CONSIDER SWEEPING AN ALREADY FREE CELL)
GYSP1:	HLRZ FXP,(FLP)
	TRZN FXP,1
	TDNE GYSP7,(FXP)
	JRST GYSP3
	JUMPN FXP,GYSP5
GYSP2:	HRRZM GYSP8,(FLP)
	HRRZI GYSP8,(FLP)
GYCNT:	AOJ .,0
GYSP3:	HRLM FXP,(FLP)
	AOBJN FLP,GYSP1
	JRST GCSWP6
GYSP7:	300,,0			;3.8=PURE, 3.7=COMPILED CODE REFS
LPROG6==.-1
OFFSET 0
.HKILL GYSP1 GYSP2 GYSP3 GYSP7 GYSP8 GYCNT

;;; PART OF SYMBOL SWEEPER - RESTORES A SYMBOL BLOCK TO FFY2.
;;; ALSO ATTEMPTS TO RETURN THE VALUE CELL IF IT HAS ONE.

GYSP5:	EXCH FXP,FFY2		;RETURN SYMBOL BLOCK TO FREELIST
	EXCH FXP,@FFY2
	TLZ FXP,-1		;MAYBE TRY TO RETURN A VALUE CELL
	CAIE FXP,SUNBOUND
	JRST GYSP5A
	SETZ FXP,
	JRST GYSP2

GYSP5A:	CAIL FXP,BXVCSG+NXVCSG*SEGSIZ
	JRST GYSP5B		;CAN ONLY RETURN CELLS IN VC SPACE
	EXCH FXP,FFVC
	MOVEM FXP,@FFVC
GYSP5B:	SETZ FXP,
	JRST GYSP2



;;; MARK AN S-EXPRESSION GIVEN IN A. TRACES IT COMPLETELY,
;;; MARKING ALL SUBITEMS BY SETTING A MARK BIT TO **ZERO**
;;; FOR LIST, FIXNUM, FLONUM, AND BIGNUM SPACES, AND TO
;;; **ONE** FOR SYMBOLS AND SARS. (THIS SPEEDS UP SWEEPING.)
;;; NEVER MARKS VALUE CELLS!!!! (THEY ARE NEVER SWEPT.)
;;; CALLED BY JSP T,GCMARK WITH OBJECT IN A. USES A,B,C,AR1,AR2A.

GCMARK:	JUMPE A,(T)		;NEEDN'T MARK NIL
	MOVEI AR2A,(P)		;REMEMBER WHERE P IS
GCMRK0:	JRST GCMRK1	.SEE KLINIT

GCMRK3:	TLNN A,GCBSYM		;MAYBE WE FOUND A SYMBOL
	 JRST GCMRK4		;NOPE
	HLRZ AR1,(C)		;YUP
	TROE AR1,1
	 JRST GCMKND
	HRLM AR1,(C)
	PUSH P,(C)		;PUSH PROPERTY LIST
	PUSH P,(AR1)		;PUSH PNAME LIST
	SKIPE ETVCFLSP		;A HAC TO SAVE TIME IF THERE NEVER HAVE BEEN
	 JRST GCMRK6		; VALUE CELLS TAKEN FROM LIST SPACE
	HRRZ A,@-1(AR1)
	JRST GCMRK1		;GO MARK VALUE OF SYMBOL

GCMRK6:	HRRZ A,-1(AR1)
	CAIGE A,EVCSG
	 CAIGE A,BVCSG
	  JRST GCMRK7
	HRRZ A,(A)
	CAIE A,QUNBOUND
	 JRST GCMRK1
	JRST GCMRK8

GCMRK7:	LSH A,-SEGLOG
	SKIPL A,GCST(A)		;SKIP IF VALUE CELL NOT A LIST CELL??
	 JRST GCMKND		;SUNBOUND, FOR EXAMPLE????
	HRRZ A,-1(AR1)		;POINTING TO A VC IN LIST SPACE
	JRST GCMRK1

GCMRK4:	TLNN A,GCBVC		;MAYBE WE FOUND A VALUE CELL
	 JRST GCMRK5		;NOPE
	HRRZ A,(C)		;YUP - MARK ITS CDR (THE VALUE)
	JRST GCMRK1

GCMRK5:	MOVSI AR1,TTS<GC>	;MUST BE AN ARRAY
	IORM AR1,TTSAR(C)	;SET ARRAY MARK BIT TO 1
GCMKND:	CAIN AR2A,(P)		;SKIP IF ANYTHING LEFT ON STACK TO MARK
	 JRST (T)		;ELSE RETURN
GCMRK8:	POP P,A			;GET NEXT ITEM TO MARK
GCMRK1:	HRRZS C,A		;ZERO LEFT HALF OF A, ALSO SAVE IN C
	SETZ B,
	LSHC A,-SEGLOG		;GET PAGE NUMBER OF ITEM (OTHER BITS GO INTO B)
	SKIPL A,GCST(A)		;CHECK GCST ENTRY FOR THAT PAGE
	 JRST GCMKND		;NOT MARKABLE - IGNORE IT
	TLNE A,GCBFOO		;MAYBE IT'S A VALUE CELL OR SYMBOL OR SAR
	 JRST GCMRK3		;IF SO HANDLE IT SPECIALLY
	LSHC A,SEGLOG-5		;THIS GETS ADDRESS OF BIT WORD FOR THIS ITEM
	ROT B,5			;B TELLS US WHICH BIT (40/WD)
	MOVE AR1,(A)		;GET WORD OF MARK BITS
	TDZN AR1,GCBT(B)	;CLEAR THE ONE PARTICULAR BIT
	 JRST GCMKND		;QUIT IF ITEM ALREADY MARKED
	MOVEM AR1,(A)		;ELSE SAVE BACK WORD OF BITS
	JUMPGE A,GCMKND		;JUMP UNLESS WE WANT TO MARK THROUGH (REMEMBER THE LSHC A,5)
	HRR A,(C)		;GET CDR OF ITEM
	TLNN A,200000		;MAYBE WE ALSO WANT TO MARK THE CAR
	 JRST GCMRK1		;NO - GO MARK CDR
	PUSH P,A		;YES - SAVE CDR ON STACK
	HLR A,(C)		;GET CAR OF ITEM AND GO MARK IT
	TLNN A,100000
	JRST GCMRK1
IFE HNKLOG, 	JRST GCMRK1
IFN HNKLOG,[
	PUSH P,T		;SAVE T AND AR2A SO CAN CALL
	HRLM AR2A,(P)		; GCMARK RECURSIVELY
	MOVEI A,(C)
	LSH A,-SEGLOG
	HRRZ A,ST(A)		;GET TYPEP OF HUNK
   2DIF [HRL C,(A)]GCHNLN,QHUNK1	;C NOW HAS AOBJN POINTER
	MOVEI AR2A,(P)		;SET UP AR2A FOR RECURSIVE GCMARK
GCMRK2:	MOVEM C,-1(P)		;SAVE AOBJN POINTER IN SLOT PUSHED FOR CDR
	HLRZ A,(C)
	JUMPE A,GCMK2A
	JSP T,GCMRK1		;MARK ODD HUNK SLOT
	MOVE C,-1(P)
GCMK2A:	HRRZ A,(C)
	JUMPE A,GCMK2B
	JSP T,GCMRK1		;MARK EVEN HUNK SLOT
	MOVE C,-1(P)
GCMK2B:	AOBJN C,GCMRK2
	POP P,T			;RESTORE T AND AR2A
	HLRZ AR2A,T
	SUB P,R70+1		;FLUSH AOBJN POINTER
	JRST GCMKND

GCHNLN:
REPEAT HNKLOG, -<2←.RPCNT>	;LH'S FOR AOBJN POINTERS
]		;END OF IFN HNKLOG

IFN ITS,[ IFE SEGLOG-11,[ IFLE HNKLOG-5,[
;;; MARK ROUTINE FOR USE WITH KL-10 MICROCODE

LSPGCM=070000,,
LSPGCS=071000,,

KLGCVC:	SKIPA A,(A)
	 PUSH P,B
KLGCM1:	LSPGCM A,KLGCM2
KLGCND:	CAIN AR2A,(P)
	 JRST (T)
	POP P,A
	JRST KLGCM1

KLGCM2:	JRST KLGCSY
	JRST KLGCVC
	JRST KLGCSA
REPEAT HNKLOG, JRST CONC KLGH,\.RPCNT+1
REPEAT 8-.+KLGCM2, .VALUE

KLGCSY:	HLRZ AR1,(A)
	TROE AR1,1
	 JRST KLGCND
	HRLM AR1,(A)
	PUSH P,(A)
	PUSH P,(AR1)
	HRRZ A,@-1(AR1)
	JRST KLGCM1

KLGCSA:	MOVSI AR1,TTS<GC>
	IORM AR1,TTSAR(A)
	JRST KLGCND

IFN HNKLOG,[
ZZZ==<1←HNKLOG>-1
REPEAT HNKLOG,[
CONC KLGH,\HNKLOG-.RPCNT,:
REPEAT 1←<HNKLOG-.RPCNT-1>,[
	PUSH P,ZZZ(A)
	HLRZ B,(P)
	PUSH P,B
ZZZ==ZZZ-1
]		;END OF REPEAT 1←<HNKLOG-.RPCNT-1>
]		;END OF REPEAT HNKLOG
IFN ZZZ, WARN [YOU LOSE]
	PUSH P,(A)
	HLRZ A,(A)
	JRST KLGCM1
]		;END OF IFN HNKLOG


KLGCSW:	MOVNI T,3+BIGNUM		;SWEEP
KLGS1:	SETZB C,AR1			;ZERO FREELIST AND COUNT
	SKIPN TT,FSSGLK+3+BIGNUM(T)
	 JRST KLGS1D
KLGS1A:	MOVE B,GCST(TT)
	LSH B,SEGLOG-5
	TLZ B,-1
	MOVEI A,(TT)
	LSH A,SEGLOG
	HRLI A,-SEGSIZ
	LSPGCS A,1
	LDB TT,[SEGBYT,,GCST(TT)]
	JUMPN TT,KLGS1A
KLGS1D:	MOVEM C,FFS+3+BIGNUM(T)
	HRRM AR1,NFFS+3+BIGNUM(T)
	AOJL T,KLGS1
	JRST GCSW4A

]]]		;END OF IFLE HNKLOG-5, IFE SEGLOG-11, IFN ITS

GSGEN:	SKIPN AR2A,GCMKL	;GENERATE TAILS OF GCMKL AND APPLY 
	POPJ P,			;FUN IN AR1 TO THEM
	PUSH P,AR1
	MOVEI AR1,GCMKL
	JRST GGEN1

RTSPC2:	JUMPE A,GGEN2
RTSP2A:	ADD D,TT
GGEN2:	HRRZ AR2A,(AR2A)	;GENERAL LOOP FOR GSGEN
	MOVEI AR1,(AR2A)
	HRRZ AR2A,(AR2A)
GGEN1:	JUMPE AR2A,POP1J	;TAIL OF GCMKL IN AR2A,
	HRRZ A,(AR2A)		;SPACE OCCUPIED IN TT,
	HLRZ A,(A)		;ALIVEP IN A
	MOVE TT,(A)
	HLRZ A,(AR2A)
	HLRZ A,ASAR(A)
	JRST @(P)	;ROUTINE WILL RETURN TO GGEN2


GFSPC:	PUSH FXP,AR1
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	POP FXP,AR1
	ADD D,@VBPORG	;NOW HAS TOTAL AMOUNT FREE IN BPS [COUNTING DEAD BLOCKS]
	ADD D,GAMNT	;NOW DIMINISHED BY REQUESTED AMOUNT
	CAMG D,BPSH
	JRST GRELAR	;IF ENOUGH SPACE, THEN RELOCATE
	JRST (R)

;GTSP5:
;$$	POP FXP,AR1
GTSP5A:	SETZB A,TT		;GIVE OUT NIL AND 0 IF FAIL
	JUMPLE AR1,CZECHI
	PUSHJ P,BPSGC
	JSP R,GFSPC
	SETZ AR1,
	JRST GTSP1B

BPSGC:	MOVEI R,444444		;GC SPECIFICALLY FOR BPS
	HRLM R,(P)
	JRST AGC

;;; SOME ROUTINES FOR USE WITH GSGEN

GCP8K:	HLRZ A,(D)
	JSP T,GCMARK
GCP8J:	HRRZ D,(D)	;MARK ATOMS ON OBLIST
GCP8I:	JUMPE D,GCP8A	;WHICH HAVE NON-TRIVIAL
	MOVE A,D	;P-LIST STRUCTURE.
	JSP T,TWAP
	JRST GCP8J
	JRST GCP8K
	JRST GCP8J

GCP8G:	JUMPE D,GCP8A	;REMOVE T.W.A.'S FROM
	MOVE A,D	;BUCKETS OF OBLIST.
	JSP T,TWAP
	JRST GCP8B
	JRST GCP8B
	HRRZ D,(D)
	TLNE R,400000	;BUCKET COMES FROM LH OF WORD IN OBARRAY
	HRLM D,(F)	;IF AT THIS POINT R < 0
	TLNN R,400000
	HRRM D,(F)
	JSP T,GCP8L
	JRST GCP8G
GCP8C:	HRRZ D,(D)
GCP8B:	HRRZ A,(D)
GCP8D:	JUMPE A,GCP8A
	JSP T,TWAP
	JRST GCP8C
	JRST GCP8C
	HRRZ A,(D)
	HRRZ A,(A)
	HRRM A,(D)
	JSP T,GCP8L
	JRST GCP8B

GCP8H:	MOVE A,D	;MARK OBLIST BUCKET
	JSP T,GCMARK
	JRST GCP8A

GCP8L:	JUMPE TT,(T)	;IF SCO REMOB'D, THEN REMOVE FROM SCO TABLE
	HRRZ A,(TT)
	JUMPN A,(T)
	HLRZ A,(TT)
	MOVE B,(A)	;MUST NOT BE INTERRUPTIBLE HERE
	MOVEI A,0
	LSHC A,7
	JUMPN B,(T)
	HRRZ TT,VOBARRAY
	HRRZ TT,TTSAR(TT)
	ADDI TT,<OBTSIZ+1>/2
	ROT A,-1
	ADD TT,A
	JUMPL TT,GCP8L5
	HRRZS (TT)
	JRST (T)
GCP8L5:	HLLZS (TT)
	JRST (T)

TWAP:	HLRZ A,(A)
	JUMPE A,(T)		;NIL IS ALREADY MARKED
	HLRZ TT,(A)
	TRZE TT,1
	JRST (T)		;NO SKIP IF ALREADY MARKED
	MOVE B,(TT)
	MOVE TT,1(TT)
	TLNN B,300		;SKIP 1 OF SYMBOL HAS SOME NON-TRIVIAL
	TLZE TT,-1		;PROPERTIES, E.G., ARGS OR COMPILED CODE REFERENCE
	JRST 1(T)
	HRRZ B,(B)
	HRRZ A,(A)
	CAIN B,QUNBOUND
	JUMPE A,2(T)		;SKIP 2 IF TRULY WORTHLESS SYMBOL, I.E., UNBOUND AND NO PROPERITES
	JRST 1(T)		;SKIP 1 IF MEANINGFUL PROPERTIES OR VALUE

;;; PRINT MESSAGE OF FORM "NNN[MM%] " FOR GC STATISTICS OUTPUT

STGPNT:	PUSH FXP,T	;RECLAIMED AMNT IN T, TOTAL FOR SPACE IN TT
	IMULI T,100.
	IDIVM T,TT
	EXCH TT,(FXP)
Q%	MOVEI R,TYO
Q$	HRRZ AR1,VMSGFILES
Q$	TLO AR1,200000
Q$	MOVEI R,$TYO
IFE USELESS,	MOVE C,@VBASE	;BASE HAD DAMNED WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN		;SKIPS
]		;END OF IFN USELESS
	   PUSHJ P,PRINI2
	STRT 17,[SIXBIT \[!\]	;BEWARE THESE BRACKETS!!!!!
	POP FXP,TT
IFE USELESS,	MOVEI C,10.
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,[10.]
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI3	;EFFECTIVELY, PRINI2 WITH *NOPOINT=T
	STRT 17,[SIXBIT \%] !\]	;BEWARE THESE BRACKETS!!!!!
	POPJ P,


;;; VERY IMPORTANT TABLE OF WORDS WITH SINGLE BITS!!! USED FOR MARKING!!!
GCBT:	REPEAT 36., SETZ←-.RPCNT

IFE D10,[

SUBTTL	RETURN CORE TO TIMESHARING SYSTEM

;;; HAIRY ROUTINE TO DECIDE WHETHER TO RETURN SOME BPS TO THE SYSTEM.
;;; MAY ONLY BE CALLED WHEN NOQUIT SPECIFIES NO INTERRUPTS.

RETSP:	MOVEI TT,4	;GTSPC1 IS ALLOWED TO GRAB 4 PAGES
	MOVEM TT,ARPGCT	; BEFORE INVOKING GC FOR LACK OF CORE
	PUSHJ P,CNLAC	;COUNT NUMBER OF LIVING ARRAY CELLS
	MOVE TT,BPSH
	LSH TT,-PAGLOG	;CURRENT HIGHEST CORE BLOCK IN BPS
	MOVE R,@VBPORG
	ADDI R,1(D)
	LSH R,-PAGLOG	;CORE NEEDED IF ARRAYS WERE PACKED
	CAML R,TT
	POPJ P,
	LSH R,PAGLOG
	ADDI R,PAGSIZ-1
	HRLM R,RTSP1	;NEW BPSH
	SUB R,D
	HRRM R,RTSP3	;NEW BPEND.
	JUMPE D,RTSP5
	HRLM D,RTSP3	;NO. OF CELLS TO MOVE.
	PUSHJ P,GRELAR	;(LEAVES BPEND-AFTER-RELOCATION IN TT.)
	HRL AR1,TT
	HRR AR1,RTSP3	;BLOCK PTR.
	SUBI TT,(AR1)
	JUMPLE TT,RTSP2
	MOVNI TT,1(TT)
	HRRM TT,RTSP1
	ADD AR1,R70+1
	HLRZ C,RTSP3
	ADD C,RTSP3
	BLT AR1,(C)
	MOVEI AR1,RTSPC1
	PUSHJ P,GSGEN	;DO PATCH-UP ON ARRAY PARAMETERS
	JSP T,RSXST	;????
RTSP2:	HLRZ TT,RTSP1
	MOVE R,TT
	EXCH R,BPSH
	HRRZ D,RTSP3
	MOVEM D,@VBPEND
IFE D10,[
	LSH R,-PAGLOG	;OLD CORE HIGHEST
	LSH TT,-PAGLOG	;NEW CORE HIGHEST
	SUBI R,(TT)
	MOVEI F,1(TT)
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI D,1(TT)
	LSH D,-SEGLOG+PAGLOG
	MOVE T,[$NXM,,QRANDOM]
	SETZ AR1,
	LSH TT,11
RTSP7:	ADDI TT,1000
	.CBLK TT,
	POPJ P,
	TLNN F,730000
	TLZ F,770000
	IDPB AR1,F
REPEAT SGS%PG,	MOVEM T,ST+.RPCNT(D)
	ADDI D,SGS%PG
	SOJG R,RTSP7
]		;END OF IFE D10
10$	CORE TT,
10$	LERR [SIXBIT \CORE?!\]
	POPJ P,

RTSP5:	SETZM GCMKL	;NO ARRAYS ALIVE
	MOVE TT,R
	PUSHJ P,BPNDST	;SETQ UP BPEND
	JRST RTSP2

RTSPC1:	JUMPE A,GGEN2
	HRRE B,RTSP1	;-(SIZE OF SHIFT + 1).
	JSP AR1,GT3D
	JRST GGEN2

]		;END OF IFE D10

SUBTTL	GET SPACE FROM TIMESHARING SYSTEM

GTSPC1:	HLLOS NOQUIT
	JSP R,GFSPC		;SEE IF FREE SPACE ABOVE BPEND WILL ADD ENOUGH
	SKIPLE AR1,ARPGCT
	JRST GTSP1B
	PUSHJ P,BPSGC		;WHEN COMPACTIFIED AND RELOCATED
	JSP R,GFSPC		;IF NOT, GC AND TRY AGAIN
GTSP1B:
IFE D10,[
	CAML D,HINXM
	JRST GTSP5A
	MOVEI T,(D)
	TRO T,PAGSIZ-1
	MOVE R,BPSH
	LSH D,-PAGLOG
	LSH R,-PAGLOG
	SUB D,R
	MOVN F,D
	ADDM F,ARPGCT
	MOVEI F,1(R)
	ROT F,-4
	ADDI F,(F)
	ROT F,-1
	TLC F,770000
	ADD F,[450200,,PURTBL]
	MOVEI TT,1(R)
	LSH TT,-SEGLOG+PAGLOG
	MOVE A,[$XM,,QRANDOM]
	PUSH FXP,AR1
	HLRZ AR1,(P)		;BEWARE! LH OF CALLING PDL SLOT = -1
	TRNN AR1,1		; MEANS THE GETSP FUNCTION IS CALLING
	TROA AR1,3
	MOVEI AR1,1
	LSH R,11
	IOR R,[004400,,400000]
GTSPC2:	ADDI R,1000
	.CBLK R,
;	JRST GTSP5		;FAILURE GIVES OUT NIL IN A, 0 IN TT
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE - TELL DDT
	TLNN F,730000
	TLZ F,770000
	IDPB AR1,F
REPEAT SGS%PG,	MOVEM A,ST+.RPCNT(TT)
	ADDI TT,SGS%PG
	SOJG D,GTSPC2
	POP FXP,AR1
	MOVEM T,BPSH		;FALLS INTO GRELAR
]		;END OF IFE D10
IFN D10,[
	SETZB A,TT		;GIVE OUT NIL AND 0 IF WE FAIL
	JRST CZECHI
]		;END OF IFN D10
GRELAR:	HLLOS NOQUIT	;MOBY DELAYED QUIT FEATURE.
	HRRZ A,BPSH	;LEAVE BPEND-AFTER-RELOCATION AS RESULT
	MOVEM A,GSBPN	;TEMPORARY BPEND
	MOVEI AR1,GTSPC3
	PUSHJ P,GSGEN	;RELOCATE ARRAYS
	JSP T,RSXST
GREL1:	MOVE TT,GSBPN
	PUSHJ P,BPNDST
	MOVE TT,(A)
CZECHI:	HLLZS NOQUIT
	JRST CHECKI	;CHECK FOR ↑G THEN POPJ P,

SUBTTL	ARRAY RELOCATOR

CNLAC:	MOVEI D,0		;COUNT NUMBER OF LIVING ARRAY CELLS, IN D
	MOVEI AR1,RTSPC2
	JRST GSGEN
BPNDST:	JSP T,FIX1A		;STORE NEW VALUE FOR BPEND
	MOVEM A,VBPEND
	POPJ P,

;;; COMES HERE FROM GRELAR VIA GSGEN.  AR2A HAS TAIL OF GCMKL, TT HAS TOTAL LENGTH OF ARRAY
GTSPC3:	JUMPE A,GT3G		;RELOCATE AN ARRAY
	MOVEI AR1,-1(TT)	;LENGTH-1 OF ARRAY IN AR1
	HLRZ A,(AR2A)
	HRRZ A,ASAR(A)
	SUBI A,1		;ARRAY AOBJN PTR LOC IN A.
	MOVE C,GSBPN
	SUBI C,(AR1)
	MOVEM C,GSBPN	;LOC NEW BPTR IN C
	MOVEI B,(C)
	SUBI B,1(A)	;RELOCATION AMOUNT-1 IN B
	CAML A,C	;IS ARRAY ALREADY IN PLACE?
	 JRST GT3C	;YES, SO EXIT
	SUBI C,(AR1)
	CAMGE A,C	;BEWARE: C COULD GO NEGATIVE!
	 JRST GT3A	;GOOD, EASY BLT
	ADDI C,(AR1)
	ADDI AR1,1(A)	;FIRST DESTINATION LOC
GT3B:	HRRZI C,(AR1)
	SUBI AR1,1(B)	;CONSTRUCT SOURCE ADDRESS
	HRLI C,(AR1)
	HRRZI T,(C)
	ADDI T,(B)
	BLT C,(T)	;SERIES OF SMALL BLTS
	CAMLE AR1,GSBPN
	 JRST GT3B
	ADDI AR1,(B)
	SUB AR1,GSBPN
	MOVE A,GSBPN
	SUBI A,1(B)
GT3A:	MOVE C,GSBPN
	ADDI AR1,(C)
	HRL C,A
	BLT C,(AR1)	;FINAL (OR ONLY) BLT
	JSP AR1,GT3D
GT3C:	SOS GSBPN
	JRST GGEN2

GT3D:	ADDI B,1
	HLRZ A,(AR2A)
	ADDM B,ASAR(A)	;UPDATE ARRAY POINTERS BY OFFSET IN B
	ADDM B,TTSAR(A)
	MOVE C,ASAR(A)
	ADDM B,-1(C)	;UPDATE AOBJN PTR BEFORE ARRAY HEADER
Q%	JRST (AR1)
IFN QIO,[
	HRR C,TTSAR(A)
	TLNE C,AS<FIL>
	 SKIPGE F.MODE(C)
	  JRST (AR1)
	MOVE C,TTSAR(A)
10%	ADDM B,AB.BP(C)		.SEE XB.AOB
10%	ADDM B,FB.IOT(C)
10$	ADDM B,FB.NBF(C)
	JRST (AR1)
]		;END OF IFN QIO

GT3G:	HRRZ AR2A,(AR2A)
	HRRZ AR2A,(AR2A)
	HRRM AR2A,(AR1)	;CUT OUT DEAD BLOCK
	JRST GGEN1

	PGTOP GC,[GARBAGE COLLECTOR]

;;; ********** MEMORY MANAGEMENT, ETC **********

SUBTTL	PURCOPY FUNCTION

	PGBOT BIB

PURCOPY:	PUSHJ FXP,SAV5M2
	PUSH P,[RST5M2]
	PUSH FXP,CCPOPJ
	PUSHJ P,SAVX5
	PUSH P,[RSTX5]
	MOVEI TT,(A)	;USES A,B,T,TT
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,PUR+VC
	POPJ P,
   2DIF JRST (TT),PCOPY9,QLIST	.SEE STDISP

PCOPY9:	JRST PCOPLS		;LIST
	JRST PCOPFX		;FIXNUM
	JRST PCOPFL		;FLONUM
BG$	JRST PCOPBN		;BIGNUM
	JRST PCOPSY		;SYMBOL
REPEAT HNKLOG, LERR PCOPER	;HUNKS
	POPJ P,			;RANDOM
	MOVSI TT,100		;ARRAY
	IORM TT,(A)		;SET "COMPILED CODE NEEDS ME" BIT
	POPJ P,

IFN HNKLOG,	PCOPER:	SIXBIT \CAN'T PURCOPY A HUNK YET!\

PCOPLS:	HLRZ B,(A)		;PURCOPY A LIST ALREADY
	PUSH P,B
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	EXCH A,(P)
	PUSHJ P,PURCOPY
	POP P,B
PCONS:	AOSL TT,NPFFS		;PURE FS CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG		;NOTE: CLOBBERS TT
	ADD TT,EPFFS
   NOPRO
	HRLM A,(TT)
	HRRM B,(TT)
	MOVEI A,(TT)
	POPJ P,

PCOPFX:	MOVE TT,(A)
PFXCONS:	CAIGE TT,XHINUM	;PURE FIXNUM CONSER
	CAMGE TT,[-XLONUM]
	JRST PFXC1
	MOVEI A,IN0(TT)
	POPJ P,			;NOTE: EXITS WITH POPJ P,!!!
PFXC1:	AOSL A,NPFFX
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFX
   NOPRO
PFXC3:	MOVEM TT,(A)
	POPJ P,


PCOPFL:	MOVE TT,(A)
PFLCONS:	AOSL A,NPFFL	;PURE FLONUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD A,EPFFL
   NOPRO
	JRST PFXC3		;ALSO EXITS WIRH POPJ P,!!!

IFN BIGNUM,[
PCOPBN:	PUSH P,(A)
	HRRZ A,(A)
	PUSHJ P,PURCOPY
	HLL A,(P)
	SUB P,R70+1
PBNCONS:	AOSL TT,NPFFB	;PURE BIGNUM CONSER
   SPECPRO INTPPC
	PUSHJ P,GTNPSG
	ADD TT,EPFFB
   NOPRO
	MOVEM A,(TT)
	MOVEI A,(TT)
	POPJ P,
]		;END OF IFN BIGNUM

PCOPSY:	PUSH P,A
	HLRZ B,(A)
	MOVE TT,(B)
	TLNE TT,200
	JRST PCOPS1
	PUSH P,B
	HRRZ A,1(B)
	PUSHJ P,PURCOPY
	POP P,B
	HRRM A,1(B)
	MOVSI TT,100
	IORM TT,(B)
PCOPS1:	LOCKI
	JSP TT,ATMHSH
	IDIVI T,OBTSIZ
	PUSH FXP,TT
	MOVEI A,(FXP)
	MOVE T,VOBARRAY
	PUSHJ P,@ASAR(T)
	MOVEI B,(A)
	HRRZ A,(P)
	PUSHJ P,MEMQ
	POP FXP,D
	JUMPN A,PCOPS3
	MOVEI T,1		;GCPROTECT
	HRRZ A,(P)
	PUSHJ P,.GCPRO
PCOPS3:	UNLOCKI
	JRST POPAJ


IFE D10,[

SUBTTL	GETCOR

;;; THIS ROUTINE IS SPECIFICALLY FOR PEOPLE WHO HAND-CODE LAP.
;;; IT IS USED TO ALLOCATE A NUMBER OF CONSECUTIVE PAGES
;;; OF MEMORY FOR VARIOUS PURPOSES, E.G. HACKING OF PDP-11'S
;;; OR INFERIOR JOBS OR WHATEVER.
;;; THE NUMBER OF PAGES DESIRED SHOULD BE IN TT; THE LOW ADDRESS
;;; OF THE PAGES IS RETURNED IN TT, OR ZERO FOR FAILURE.
;;; THIS ROUTINE DOES NOT ACTUALLY GET CORE; IT MERELY RESERVES
;;; ADDRESS SPACE.
;;; THERE IS CURRENTLY NO PROVISION FOR RETURNING THE MEMORY GRABBED.

GETCOR:	HLLOS NOQUIT
	LSH TT,PAGLOG
	MOVE T,HINXM
	SUBI T,(TT)
	CAMGE T,BPSH
	JRST GTCOR6
	MOVEI F,(TT)		;GETTING F THIS WAY FLUSHES
	LSH F,-PAGLOG		; RANDOM BITS. (IT'S SAFER.)
GTCOR4:	JSP R,ALIMPG
	.VALUE			;HOW CAN WE LOSE HERE?
	SOJG F,GTCOR4
	SKIPA TT,HINXM
GTCOR6:	TDZA TT,TT		;LOSE, LOSE, LOSE
	ADDI TT,1
	JRST CZECHI



SUBTTL	PDL OVERFLOW HANDLER


;PDLSTH:	0		;HACK ST FOR ADDING PDL PAGES
PDLST0:	MOVEI R,(D)		;USED BY PDLHAK TO EXTEND PDLS
	LSH R,11-PAGLOG		;D HAS BASE ADDRESS OF PAGE DESIRED
	IOR R,[4400,,400000]	;USES ONLY D AND R
	.CBLK R,		;CAUSE NEW PDL PAGE TO EXIST
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVEI R,(D)		;CALCULATE PURTBL BYTE POINTER
	ROT R,-PAGLOG-4
	ADDI R,(R)
	ROT R,-1
	TLC R,770000
	ADD R,[430200,,PURTBL]
	MOVEM P,FAKFXP		;SAVE P AT BOTTOM OF FAKE FXPDL
	MOVEI P,3
	DPB P,R			;UPDATE PURTBL
	LSH D,-SEGLOG			;HORRIBLE HACKERY TO UPDATE ST
	ADD D,[-SGS%PG-1,,ST-1]		; WITHOUT AN EXTRA AC:
Q% REPEAT SGS%PG, PUSH D,PDLST9-P(A)	; USE PUSHES! (CAN'T OVERFLOW)
Q$ REPEAT SGS%PG, PUSH D,PDLST9-P(F)	; USE PUSHES! (CAN'T OVERFLOW)
	MOVE P,FAKFXP
	JRST @PDLSTH


;;;	IFE D10

IFE QIO,[

;PDLHAK:	0		;CALLED WHEN SOME PDL OVERFLOWS
PDLH0:	MOVEM D,QITD		;A=0 => CAUSED BY PUSH OR PUSHJ, ELSE
	MOVEM R,QITR		; UINT0 GIVES <# SLOTS NEEDED,,PDL AC>
	JUMPN A,PDLH0A		;SO JUMP IF WE KNOW WHICH ONE
	MOVEI A,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI A,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI A,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI A,FLP		;IF NOT FLP, THEN USER HAS LOST!
	JUMPL FLP,[LERR [SIXBIT \USER PDL OVERFLOW!\]]
;	JUMPGE FLP,PDLH0A
;IRP Z,,[P,FLP,FXP,SP]
;	MOVES (Z)		;CROCK DUE TO ITS LOSSAGE
;TERMIN
;	JRST PDLH3
PDLH0A:	HRRZ R,(A)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(A)		;IF WE'RE OVER THE ORIGIN OF THE
	JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,A
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(A)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	MOVE R,OC2-P(A)		; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(A)	;SKIP IF WE'RE ABOVE PDLMAX
	JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO A,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(A)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(A)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	SUBI D,20
	MOVEM D,ZPDL-P(A)
	HRRZ D,(A)
	JRST PDLH2A
PDLH2:	TLZE A,-1
	JRST PDLH2B
	CAMLE R,ZPDL-P(A)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	MOVE R,ZPDL-P(A)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(A)		;CLOBBER INTO PDL PTR
	HRRZ D,(A)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN A,-1		;SKIP IF WE WERE ABOVE PDLMAX
	JRST PDLH3
	HRLI A,QREGPDL-P(A)
	HRRI A,12.		;STACK UP USER INT 12. (PDL-OVERFLOW)
	HRRZ D,PDLHAK		;CAN STACK IT BECAUSE WE'RE IN UINT,
	CAIN D,PDLOV3+1		; WHICH WILL DO A CHECKI
	JRST PDLH4
	MOVE D,QITD		;RESTORE D AND R SO UISTAK
	MOVE R,QITR		; CAN SAVE THEM AGAIN
	JSR UISTAK
PDLH3:	SETZ A,
PDLH4:	MOVE D,QITD		;A NON-ZERO MEANS WE WANT TO RUN
	MOVE R,QITR		; A PDL-OVERFLOW INT
	JRST @PDLHAK

]		;END OF IFE QIO


;;;	IFE D10

IFN QIO,[

;;; HAIRY PDL OVERFLOW HANDLER

PDLOV:	MOVE F,INTPDL
	MOVEM D,IPSWD2(F)	;SAVE D
	MOVEM R,IPSWD1(F)	;SAVE R
	SKIPL INTPDL
	 .VALUE			;I WANT TO SEE THIS! - GLS
	MOVEI F,P		;ALL RIGHT THEN, LET'S PLAY
	JUMPGE P,PDLH0A		; TWENTY QUESTIONS - IS IT REGPDL?
	MOVEI F,SP
	JUMPGE SP,PDLH0A	;SPECPDL?
	MOVEI F,FXP
	JUMPGE FXP,PDLH0A	;FXP?
	MOVEI F,FLP		;IF NOT FLP, THEN IT'S PRETTY RANDOM
	JUMPGE FLP,PDLH0A
	HLRZ R,NOQUIT
	JUMPN R,PDLH3A
	LERR [SIXBIT \RANDOM PDL OVERFLOW!\]

PDLH0A:	HRRZ R,(F)		;FETCH RIGHT HALF OF PDL POINTER
	MOVEI D,(R)
	CAML R,OC2-P(F)		;IF WE'RE OVER THE ORIGIN OF THE
	 JRST PDLH5		; OVERFLOW PDL, THEN ERROR OUT
	HLRZ R,F
	ADDI R,11(D)		;HERE IS A HACK TO PAGIFY
	IORI R,PAGSIZ-1		; UPWARDS, BUT KEEP WELL AWAY
	SUBI R,10		; FROM THE PAGE BOUNDARY
	CAML R,OC2-P(F)		;IF WE'RE ABOVE THE OVERFLOW PDL,
	 MOVE R,OC2-P(F)	; ONLY INCREASE TO THAT PLACE
	CAMGE D,ZPDL-P(F)	;SKIP IF WE'RE ABOVE PDLMAX
	 JRST PDLH2		; PARAMETER FOR THIS PDL
	TLO F,-1		;SET FLAG TO INDICATE THIS FACT
	MOVE D,MORPDL-P(F)	;PUSH UP THE PDLMAX
	ADD D,ZPDL-P(F)		; "SOME MORE"
	ANDI D,777760		;BUT KEEP AWAY FROM PAGE
	TRNN D,PAGKSM		; BOUNDARY (PICKY, PICKY!)
	 SUBI D,20
	MOVEM D,ZPDL-P(F)
	HRRZ D,(F)
	JRST PDLH2A

PDLH2:	TLZE F,-1
	 JRST PDLH2B
	CAMLE R,ZPDL-P(F)	;IF OUR GUESS WOULD PUT US OVER
PDLH2A:	 MOVE R,ZPDL-P(F)	; PDLMAX, GO ONLY AS FAR AS THAT
PDLH2B:	SUBI D,(R)		;CALCULATE NEW LEFT HALF FOR PDL PTR
	HRLM D,(F)		;CLOBBER INTO PDL PTR
	HRRZ D,(F)		;FIGURE OUT IF WE NEED TOP GET
	ADDI R,10		; MORE CORE FOR ALL THIS
	ANDI R,PAGMSK
	EXCH R,D
	CAIG R,(D)		;SKIP IF WE CROSSED NO PAGE BOUNDARY
	 JSR PDLSTH		;ELSE MUST GET NEW PAGE AND UPDATE ST
	TLZN F,-1		;SKIP IF WE WERE ABOVE PDLMAX
	 JRST PDLH3A
	MOVSI D,QREGPDL-P(F)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLH3A:	HRRZ F,INTPDL
	JRST INTXIT+1


PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,IWAIT		; OVERFLOW HANDLER!!!
	 PUSHJ P,UINT
	HRRZ F,INTPDL		;RESTORE THE WORLD
	JRST INTXIT
	
]		;END OF IFN QIO


;;;	IFE D10

IFE QIO,[
PDLOV:	.SUSET [.SIPIRQC,,A]
	SETZ A,		;MEANS WE DON'T KNOW WHICH PDL YET
PDLOV3:	JSR PDLHAK	;FIGURE IT OUT
	JUMPE A,INTEX1
	MOVEM A,CNTROL	;THIS IS A HACK
	MOVEI A,INTEX1
	EXCH A,CNTROL
	JRST UINT1R	;GO RUN PDL-OVERFLOW INTERRUPT
]		;END OF IFE QIO

MORPDL:	400		;AMOUNTS TO INCREMENT PDLS BY
	100		; WHEN OVERFLOW OCCURS (THIS GIVES
	LSWS+100	; LOSER A CHANCE TO SSTATUS PDLMAX,
	200		; AT LEAST)

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC

PDLST9:	$XM,,QRANDOM		;TYPICAL ST ENTRIES FOR PDL PAGES
	$FLP,,QFLONUM
	$FXP,,QFIXNUM
	$XM,,QRANDOM

PDLH5:	IORI R,PAGSIZ-1		;BAD PDL OV - REALLY DESPERATE
	SUBI D,-2(R)		;GIVE US AS MUCH PDL AS IS LEFT
	JUMPL D,PDLH6
	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
Q%	STRT @PDLMSG-P(A)
Q$	STRT @PDLMSG-P(F)
	JRST DIE

PDLH6:
Q%	HRLM D,(A)
Q$	HRLM D,(F)
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;FOO! HAPPENED IN GC - BOMB OUT!
Q%	HRRZ B,PDLMSG-P(A)
Q$	HRRZ B,PDLMSG-P(F)
	CAIE B,POVSPDL
	JRST PDLOV5		;PDLOV5 HANDLE WILL GET US TO TOP LEVEL
	MOVEM P,F		;FOR SP, TRY TO POP BINDINGS FIRST
	HRRZ TT,SPSV		; SO *RSET-TRAP WON'T OVERFLOW
	MOVE P,[-LFAKP-1,,FAKP]	;SO WE HAVE ENOUGH PDL FOR UBD
	PUSH P,FXP
	MOVE FXP,[-LFAKFXP-1,,FAKFXP]
	PUSHJ P,UBD
	POP P,FXP
	MOVE P,F
	JRST PDLOV5		;PDLOV5 WILL SET UP PDLS

]		;END OF IFE D10


SUBTTL	PURE SEGMENT CONSER

;;; GTNPSG IS INVOKED AS FOLLOWS:
;;;		AOSL A,NPFF%	;SKIP UNLESS NO MORE LEFT
;;;	   SPECPRO INTPPC
;;;		PUSHJ P,GTNPSG	;MUST GET MORE
;;;		ADD A,EPFF%	;ELSE JUST FIGURE OUT ABSOLUTE ADDRESS
;;;	   NOPRO
;;; WHERE % IS SOME APPROPRIATE LETTER (E.G. S, X, L, B).
;;; GTNPSG UPDATES NPFF% AND EPFF% BY LOOKING AT THE AOSL, THEN
;;; RETURNS TO THE AOSL.

   XCTPRO
GTNPSG:	HLLOS NOQUIT		;GET NEW PURE SEGMENT
   NOPRO
	SOS (P)
	SOS (P)
	SAVEFX T TT D
GTNPS1:	MOVEI T,-SEGSIZ		;*NOT* "MOVNI T,SEGSIZ" !!!
	ADDB T,PSGAOB		;INCR'S LH BY 1, DECR'S RH BY SEGSIZ
	JUMPGE T,GTNPS3		;FOO! MUST GRAB A NEW PAGE!
	TLZ T,-1
	LSH T,-SEGLOG
	MOVE D,@(P)		;D POINTS TO NPFF%
	MOVE TT,GTNPS8-NPFFS(D)
	MOVEM TT,ST(T)
	SETZM GCST(T)
	LSH T,SEGLOG
	ADDI T,SEGSIZ
	MOVEM T,EPFFS-NPFFS(D)	;UPDATE PARAMETERS FOR NEW
	MOVNI T,SEGSIZ+1	; PURE SEGMENT
	MOVEM T,(D)
	MOVEI T,SEGSIZ
	ADDM T,PFSSIZ-NPFFS(D)	;UPDATE STORAGE SIZE
	RSTRFX D TT T
	JRST CZECHI

GTNPS8:	LS+$FS+PUR,,QLIST	;TYPICAL ST ENTRIES FOR PURE SEGMENTS
	$FX+PUR,,QFIXNUM
	$FL+PUR,,QFLONUM
BG$	BN+PUR,,QBIGNUM
	$XM+PUR,,QRANDOM


GTNPS3:
IFE D10,[
	MOVE T,HINXM		;FIGURE OUT IF ANY ROOM LEFT
	SUBI T,PAGSIZ
	CAMGE T,BPSH
]		;END OF IFE D10
IFN D10,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFN D10
	 LERR [SIXBIT \NO SPACE FOR NEW PURE PAGE!\]
IFE D10,[
	AOS TT,HINXM
	MOVEM T,HINXM		;UPDATE HINXM
	HRLI TT,-SGS%PG-1
	MOVEM TT,PSGAOB		;UPDATE AOBJN PTR
	MOVEI TT,1(T)
]		;END OF IFE D10
IFN D10,[
	MOVEM TT,HIXM
	HRLI TT,-SGS%PG-1
	MOVEM TT,PSGAOB
	AOS PSGAOB
	TLZ TT,-1
]		;END OF IFN D10
	LSH TT,-SEGLOG		;UPDATE ST AND GCST FOR NEW PAGE
	MOVE D,[$XM+PUR,,QRANDOM]
REPEAT SGS%PG, MOVEM D,ST+.RPCNT(TT)
REPEAT SGS%PG, SETZM GCST+.RPCNT(TT)
IFE D10,[
	MOVEI TT,1(T)		;UPDATE PURTBL
	ROT TT,-PAGLOG-4
	ADDI TT,(TT)
	ROT TT,-1
	TLC TT,770000
	ADD TT,[430200,,PURTBL]
	DPB T,TT		;T HAS 11 IN LOW TWO BITS
	MOVEI TT,1(T)		;MEANS CAN PURIFY IF WE THINK ABOUT IT
	LSH TT,11-PAGLOG
	IOR TT,[4400,,400000]
	.CBLK TT,
	 .LOSE 1000+%ENACR
]		;END OF IFE D10
IFN D10,[
	HRRZ TT,HIXM
	CORE TT,
	 .VALUE
]		;END OF IFN D10
	JRST GTNPS1


SUBTTL	FREE STORAGE SPACE EXPANSION

;;; THIS PORTION OF THE GARBAGE COLLECTOR DETERMINES WHETHER
;;; WE SHOULD JUST GRAB A NEW SEGMENT OF FREE STORAGE FOR SOME
;;; CONSER, OR DO A FULL-BLOWN GARBAGE COLLECTION. IT IS
;;; CONTROLLED BY PARAMETERS SETTABLE VIA (SSTATUS GCSIZE ...).

GCGRAB:	MOVN R,D
	JFFO R,.+1		;DETERMINE WHICH SPACE WANTED MORE
	SUBI F,NFF
	MOVEI AR2A,1		;MACRAK SEZ: GRAB JUST ONE
	SKIPN FFY2
	 SETZ F,
	JUMPE F,GCGRB1		; ... SEZ MACRAK
	MOVE D,SFSSIZ+NFF(F)
	CAML D,GFSSIZ+NFF(F)	;CAN'T JUST GRAB IF ABOVE SIZE
	 JRST AGC1Q		; SPECIFIED FOR "FREE GRABBIES"
	MOVE D,GFSSIZ+NFF(F)
	CAMLE D,XFFS+NFF(F)	;CAN'T GRAB IF IT WOULD PUT
	 JRST AGC1Q		; US ABOVE THE MAXIMUM SIZE
GCGRB1:	PUSH FXP,AR2A
	PUSHJ P,GRABWORRY
	POP FXP,AR1
	JUMPL AR2A,GCEND	;JUMP IF WE GOT ALL THE CORE
	JRST AGC1Q		;GO DO FULL-BLOWN GC AFTER ALL


;;; THIS ROUTINE WORRIES ABOUT GETTING A NEW IMPURE FREE STORAGE
;;; SEGMENT. (FOR PURE FREE STORAGE SEGMENTS, SEE GTNPSG.)
;;; MUST DO SPECIAL HACKERY FOR SYMBOL AND SAR SPACES, SINCE THEY
;;; REQUIRE MORE THAN ONE CONSECUTIVE SEGMENT. PRINTS OUT PRETTY
;;; MESSAGES IF GCGAG IS NON-NIL.
;;; MUST HAVE NOQUIT NON-ZERO AND ST/GCST PAGES IMPURE WHEN ENTERING!

GCWORRY:	SUBI AR2A,(TT)	;ENTRY FOR GARBAGE COLLECTOR
	ADDI AR2A,SEGSIZ-1	;FIGURE OUT HOW MANY NEW SEGMENTS WE NEED
	LSH AR2A,-SEGLOG
GRABWORRY:
Q$	HRRZ AR1,VMSGFILES
Q$	TLO AR1,200000
	JUMPE F,.+2	;ENTRY FOR GCGRAB
	SKIPN GCGAGV		;MAYBE WE WANT A PRETTY MESSAGE?
	 SOJA AR2A,GCWOR2	;IF NOT, DECR AR2A (SEE BELOW)
	STRT 17,[SIXBIT \↑M;ADDING !\]
	SOJG AR2A,GCWR0A	;AR2A GETS DECR'ED HERE, TOO!
	STRT 17,[SIXBIT \A!\]	;KEEP THE ENGLISH GOOD
	JRST GCWR0B

GCWR0A:
Q%	MOVEI R,TYO
Q$	MOVEI R,$TYO
	MOVEI TT,1(AR2A)
Q$	PUSH FXP,AR2A
IFE USELESS,	MOVE C,@VBASE		;BASE DAMN WELL BETTER BE A FIXNUM
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
Q$	POP FXP,AR2A
GCWR0B:	STRT 17,[SIXBIT \ NEW !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SEGMENT!\]
	SKIPE AR2A
	 STRT 17,[SIXBIT \S!\]
GCWOR2:	SKIPE TT,IMSGLK
	 JRST GCWR2A		;JUMP IF ANY SEGMENTS AVAILABLE
	JSP R,ALIMPG		;ELSE MUST GRAB A NEW PAGE
	 JRST GCWOR7
GCWR2A:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR THE FREE SEGMENT LIST
	MOVE D,FSSGLK+NFF(F)	;CONS NEW SEGMENT ONTO LIST
	MOVEM TT,FSSGLK+NFF(F)	; OF SEGMENTS FOR THE
	HRRZ R,BTBAOB		; PARTICULAR SPACE
	HLL R,GCWORS+NFF(F)
	LSH D,22-<SEGLOG-5>
	TLNE R,$FS+$FX+$FL+BN+HNK
	 IORI D,(R)		;MAYBE ALLOCATE A BIT BLOCK FOR
	IOR D,GCWORG+NFF(F)	; THE NEW SEGMENT FOR USE BY
	MOVEM D,GCST(TT)	; GC IN MARKING CELLS
	MOVE D,GCWORS+NFF(F)	;UPDATE ST ENTRY FOR THE
	MOVEM D,ST(TT)		; NEW SEGMENT
	MOVE D,FFS+NFF(F)	;ADD CELLS OF SEGMENT TO
	LSH TT,SEGLOG		; THE FREE STORAGE
	MOVEM D,(TT)		; LIST FOR THIS SPACE
	MOVE D,[GCWORX,,1]
	BLT D,LPROG9
	HLL TT,GCWORN+NFF(F)
	HRR GCWRX1,GCWORN+NFF(F)
	HRRI GCWRX2,-1(GCWRX1)
	JRST GCWRX1


GCWR2C:	HRRZM TT,FFS+NFF(F)
	TLNN R,$FS+$FX+$FL+BN+HNK
	 JRST GCWR4Q
	HRRZ TT,BTBAOB		;DECIDE WHETHER THIS BIT BLOCK
	LSH TT,SEGLOG-5		; LIES IN MAIN BIT BLOCK AREA
	MOVEI D,-1(TT)
	CAME D,MAINBITBLT
	 JRST GCWR3A
	ADDI D,BTBSIZ		;YES - JUST UPDATE MAIN BLT
	MOVEM D,MAINBITBLT	; POINTER FOR CLEARING 
	JRST GCWR3B		; BIT BLOCKS (SEE GCINBT)

GCWR3A:	LSH TT,-SEGLOG		;ELSE AOS COUNT OF BIT BLOCKS
	AOS GCST(TT)		; IN CURRENT BIT BLOCK SEGMENT
GCWR3B:	MOVE TT,BTBAOB		;AOBJN THE BIT BLOCK
	AOBJN TT,GCWOR4		; ALLOCATION POINTER
	SKIPE TT,IMSGLK		;FOO! OUT OF BIT BLOCKS!
	 JRST GCWR3F
	JSP R,ALIMPG		;FOO FOO! NEED NEW PAGE!
	 JRST GCWFOO
GCWR3F:	LDB D,[SEGBYT,,GCST(TT)]
	MOVEM D,IMSGLK		;CDR LIST OF FREE SEGMENTS
	MOVE D,[$XM,,QRANDOM]	;UPDATE ST AND GCST FOR
	MOVEM D,ST(TT)		; NEW BIT BLOCK SEGMENT
	MOVEI D,(TT)		;GCST ENTRY IS USED TO
	LSH D,5			; INDICATE HOW MANY
	MOVEM D,GCST(TT)	; BLOCKS ARE IN USE
	MOVE D,BTSGLK		;CONS NEW SEGMENT ONTO LIST
	DPB D,[SEGBYT,,GCST(TT)]	; OF BIT BLOCK SEGMENTS
	MOVEM TT,BTSGLK
	LSH TT,5		;CALCULATE NEW BIT BLOCK
	HRLI TT,-SEGSIZ/BTBSIZ	; ALLOCATION POINTER
GCWOR4:	MOVEM TT,BTBAOB
GCWR4Q:	JUMPE F,GCWOR6
	MOVEI TT,SEGSIZ		;UPDATE VARIOUS GC PARAMETERS
	ADDM TT,NFFS+NFF(F)
	ADDB TT,SFSSIZ+NFF(F)
	CAMLE TT,XFFS+NFF(F)	;MUST STOP IF OVER MAX
	 SOJA AR2A,.+2		;KEEP COUNT ACCURATE
GCWOR6:	SOJGE AR2A,GCWOR2	;ALSO STOP IF WE GOT ALL WE WANT
GCWOR7:	JUMPE F,CPOPJ
	SKIPN GCGAGV		;MAYBE WANT MORE PRETTY MESSAGE
	 POPJ P,
	SKIPL AR2A
	 STRT 17,[SIXBIT \↑M; BUT CAN'T GET THEM ALL!\]
	STRT 17,[SIXBIT \ -- !\]
	STRT 17,@GSTRT9+NFF(F)
	STRT 17,[SIXBIT \ SPACE NOW !\]
Q%	MOVEI R,TYO
IFN QIO,[
	MOVEI R,$TYO
	PUSH FXP,AR2A
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
]		;END OF IFN QIO
	MOVE TT,SFSSIZ+NFF(F)
IFE USELESS,	MOVE C,@VBASE
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	STRT 17,[SIXBIT \ WORDS!\]
Q$	POP FXP,AR2A
	POPJ P,


GCWORG:	GCBMRK+GCBCDR+GCBCAR,,	;TYPICAL GCST ENTRIES FOR IMPURE SPACES
	GCBMRK,,
	GCBMRK,,
BG$	GCBMRK+GCBCDR,,
	GCBMRK+GCBSYM,,
REPEAT HNKLOG, GCBMRK+GCBCDR+GCBCAR+GCBHNK,,
	GCBMRK+GCBSAR,,
IFN .-GCWORG-NFF, WARN [WRONG LENGTH TABLE]
	0

GCWORS:	LS+$FS,,QLIST	;TYPICAL ST ENTRIES
	$FX,,QFIXNUM
	$FL,,QFLONUM
BG$	BN,,QBIGNUM
	SY,,QSYMBOL
REPEAT HNKLOG, LS+HNK,,QHUNK1+.RPCNT
	SA+$XM,,QARRAY
IFN .-GCWORS-NFF, WARN [WRONG LENGTH TABLE]
	$XM,,QRANDOM

GCWFOO:	STRT [SIXBIT \↑M;GLEEP#! OUT OF BIT BLOCKS!\]
	JRST GCWOR7

GCWORX:			;EXTEND FREELIST THROUGH NEW SEGMENT
OFFSET 1-.
GCWRX1:	HRRZM TT,1(TT)	;OCCUPIES A,B,C,AR1 - MUST SAVE AR2A
GCWRX2:	ADDI TT,.
	AOBJN TT,GCWRX1
	JRST GCWR2C
LPROG9==.-1
OFFSET 0
.HKILL GCWRX1 GCWRX2

GCWORN:	-SEGSIZ+1,,1		;LIST
	-SEGSIZ+1,,1		;FIXNUM
	-SEGSIZ+1,,1		;FLONUM
BG$	-SEGSIZ+1,,1		;BIGNUM
	-SEGSIZ+1,,1		;SYMBOL
REPEAT HNKLOG, -SEGSIZ/<2←.RPCNT>+1,,2←.RPCNT	;HUNKS
	-SEGSIZ/2+1,,2		;ARRAY SARS
IFN .-GCWORN-NFF, WARN [WRONG LENGTH TABLE]
	-SEGSIZ/2+1,,2		;SYMBOL BLOCKS


SUBTTL	IMPURE PAGE GOBBLER

;;; ALLOCATE AN IMPURE PAGE FREE STORAGE USE

ALIMPG:
IFE D10,[
	MOVE TT,HINXM		;MUST SAVE AR2A AND F FOR GCWORRY
	SUBI TT,PAGSIZ
	CAMGE TT,BPSH
]		;END OF IFE D10
IFN D10,[
	MOVE TT,HIXM
	ADDI TT,PAGSIZ
	CAMLE TT,MAXNXM
]		;END OF IFN D10
	 JRST (R)		;NO PAGES LEFT - RETURN WITHOUT SKIP
IFE D10,[
	MOVEM TT,HINXM		;ELSE UPDATE HINXM
	MOVEI TT,1(TT)
	LSH TT,11-PAGLOG
	IOR TT,[4400,,400000]
	.CBLK TT,		;SO GET THE NEW PAGE OF CORE
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVE TT,HINXM
	MOVEI D,1(TT)		;COMPUTE A MAGIC BYTE POINTER
	LSH D,-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[430200,,PURTBL]
	MOVEI C,1
	DPB C,D			;UPDATE THE PURTBL
	TLZ R,-1
	CAIN R,GTCOR4+1		;DON'T HACK IMSGLK FOR GETCOR
	 JRST 1(R)
]		;END OF IFE D10
IFN D10,[
	MOVEM TT,HIXM
	CORE TT,
	 .VALUE
	MOVE TT,HIXM
]		;END OF IFN D10
	LSH TT,-SEGLOG
10%	ADDI TT,SGS%PG
	MOVE C,IMSGLK		;UPDATE ST AND GCST, AND ADD
	MOVE AR1,[$XM,,QRANDOM]	; NEW SEGMENTS TO IMSGLK LIST
	MOVEI D,SGS%PG
ALIMP3:	MOVEM AR1,ST(TT)
	SETZM GCST(TT)
	DPB C,[SEGBYT,,GCST(TT)]
	MOVEI C,(TT)
	SOJE D,ALIMP4
	SOJA TT,ALIMP3
ALIMP4:	MOVEM TT,IMSGLK		;WINNING RETURN SKIPS
	JRST 1(R)		;EXITS WITH LOWEST NEW SEGMENT # IN TT


SUBTTL	RECLAIM FUNCTION

IFN BIGNUM+USELESS,[
RECL1:	SKOTT A,LS+PUR
   2DIF JRST (TT),RECL9-1,QLIST	.SEE STDISP
	TLNE TT,HNK+VC+PUR	;DON'T RECLAIM VALUE CELLS!!! (OR HUNKS)
	POPJ P,			; - ALSO DON'T RECLAIM PURE WORDS
	PUSH P,A		;SAVE ARG
	JUMPE B,RECL2		;B=NIL => RECLAIM ONLY TOP LEVEL OF LIST
	HLRZ A,(A)		;RECLAIM CAR
	PUSHJ P,RECL1
RECL2:	MOVE T,FFS
	POP P,FFS
	EXCH T,@FFS		;RECLAIM ONE CELL
	MOVEI A,(T)		;AND THEN GO AFTER THE CDR
	JRST RECL1

REFXS:	JUMPE B,RECL9A		;B=NIL => DON'T RECLAIM FULLWORDS
	TLNE TT,$FXP		;DON'T RECLAIM PDL LOCATIONS!!!
	POPJ P,
	MOVE T,FFX		;RECLAIM FIXNUM
	MOVEM T,(A)
	MOVEM A,FFX
	POPJ P,

REFLS:	JUMPE B,RECL9A		;B=NIL => DON'T RECLAIM FULLWORDS
	TLNE TT,$FLP		;DON'T RECLAIM PDL LOCATIONS!!!
	POPJ P,
	MOVE T,FFL		;RECLAIM FLONUM
	MOVEM T,(A)
	MOVEM A,FFL
	POPJ P,

IFN BIGNUM,[
REBIG:	MOVE T,FFB		;RECLAIM BIGNUM HEADER
	EXCH T,(A)
	MOVEM A,FFB
	MOVEI A,(T)		;RECLAIM CDR OF BIGNUM
	JRST RECL1
]		;END OF IFN BIGNUM

RECL9:	JRST REFXS	;FIXNUM
	JRST REFLS	;FLONUM
BG$	JRST REBIG	;BIGNUM
RECL9A:	POPJ P,		;SYMBOL
REPEAT HNKLOG, .VALUE	;HUNKS
	POPJ P,		;RANDOM
	POPJ P,		;ARRAY
IFN .-RECL9-NTYPES+1, WARN [WRONG LENGTH TABLE]

]		;END OF IFN BIGNUM+USELESS


IFN ITS,[

SUBTTL	VALUE CELL AND SYMBOL BLOCK HACKERY

;;; ROUTINE TO GET MORE VALUE CELL SPACE.
;;; EXPANDS VALUE CELL SPACE BY GETTING NEXT PAGE IN THE HOLE
;;; LEFT FOR THIS PURPOSE, AND EXTENDING THE VALUE CELL FREELIST.
;;; IF NO PAGES LEFT IN THE HOLE, A LIST CELL IS USED.

   XCTPRO
MAKVC3:	HLLOS NOQUIT
   NOPRO
	SOSL NFVCP
	JRST MAKVC4
	PUSHJ P,CZECHI
	PUSHJ P,CONS1
	SETOM ETVCFLSP
	JRST MAKVC1

MAKVC4:	MOVE A,EFVCS
	LSH A,11-PAGLOG
	IOR A,[4400,,400000]
	.CBLK A,		;SO GET THE NEW PAGE IN OUR CORE MAP
	 .LOSE 1000+%ENACR	;NO CORE AVAILABLE
	MOVE A,EFVCS
	MOVEM A,FFVC
	LSH A,-SEGLOG
	MOVE TT,[LS+VC,,QLIST]
REPEAT SGS%PG, MOVEM TT,ST+.RPCNT(A)
	MOVSI TT,GCBMRK+GCBVC
REPEAT SGS%PG, MOVEM TT,GCST+.RPCNT(A)
	LSH A,-PAGLOG+SEGLOG	;UPDATE PURTBL
	ROT A,-4
	ADDI A,(A)
	ROT A,-1
	TLC A,770000
	ADD A,[430200,,PURTBL]
	MOVEI TT,1
	DPB TT,A
	AOS TT,EFVCS
	HRLI TT,-PAGSIZ+1
	HRRZM TT,-1(TT)
	AOBJN TT,.-1
	HRRZM TT,EFVCS
MAKVC8:	PUSHJ P,CZECHI
	JRST MAKVC0

]		;END OF IFN ITS


;;; SYMBOL BLOCK COPYING ROUTINE - TRIGGERED BY PURE PAGE TRAP, OR EXPLICIT CHECK
;;;	B POINTS TO OLD SYMBOL BLOCK
;;;	LEAVES POINTER TO NEW SYMBOL BLOCK IN B
;;;	CLOBBERS TT, LEAVES POINTER TO VALUE CELL IN A

LDPRG9:	TLCA B,LDPARG		;FASLOAD CLOBBERING ARGS PROP
ARGCL7:	TLC B,ARGCL3		;ARGS CLOBBERING ARGS PROP
	HRRZ A,(B)
	JRST MAKVC6

MAKVC9:	TLCA B,MAKVCX		;MAKVC CLOBBERING IN VALUE CELL
MAKVC5:	PUSHJ P,AGC
   BAKPRO
MAKVC6:	SKIPN FFY2		;COME HERE IF HRRM ABOVE CAUSES
	JRST MAKVC5		; A PURE PAGE TRAP - MUST COPY
	MOVE TT,@FFY2		; SYMBOL BLOCK FOR THAT SYMBOL
   XCTPRO
	EXCH TT,FFY2
   NOPRO
	HRLI A,777100		;ASSUME COMPILED CODE NEEDS IT
	MOVEM A,(TT)		; (THINK ABOUT THIS SOME MORE)
	MOVE A,1(B)
	MOVEM A,1(TT)
	HRRZ A,(TT)
	HRLM TT,@(P)
	EXCH TT,B
	HLRZ TT,TT
	JRST (TT)



SUBTTL	ALLOC FUNCTION

$ALLOC:	CAIE A,TRUTH		;SUBR 1 - DYNAMIC ALLOC
	 JRST $ALLC5
	SETO F,			;ARG=T => MAKE UP LIST
	EXCH F,INHIBIT		;CROCKISH LOCKI - DOESN'T MUNG FXP
	MOVNI R,NFF
$ALLC6:	PUSH FXP,GFSSIZ+NFF(R)	;SAVE UP VALUABLE DATA
	PUSH FXP,XFFS+NFF(R)	;LOCKI KEEPS IT CONSISTENT
	PUSH FXP,MFFS+NFF(R)
	AOJL R,$ALLC6
10% REPEAT 4,	PUSH FXP,XPDL+.RPCNT
	MOVEM F,INHIBIT		;EQUALLY CROCKISH UNLOCKI
	PUSHJ P,CHECKI
	PUSH P,R70
IFN ITS,[
	MOVEI R,4
$ALLC9:	POP FXP,TT
	SUB TT,C2-1(R)
	TLZ TT,-1
	JSP T,FIX1A
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QREGPDL-1(R)
	PUSHJ P,XCONS
	MOVEM A,(P)
	SOJG R,$ALLC9
]		;END OF IFN ITS
	MOVEI R,NFF
$ALLC7:	SKIPN SFSSIZ-1(R)
	 JRST $ALLC8		;SPACE SIZE IS ZERO - IGNORE IT
	POP FXP,TT
	PUSHJ P,SSGP2A
	PUSHJ P,NCONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVEI B,(A)
	POP FXP,TT
	JSP T,FIX1A
	PUSHJ P,CONS
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEI B,QLIST-1(R)
	CAIN B,QRANDOM
	MOVEI B,QARRAY
	PUSHJ P,XCONS
	MOVEM A,(P)
	JRST $ALLC4

$ALLC8:	SUB FXP,R70+3		;FLUSH GARBAGE
$ALLC4:	SOJG R,$ALLC7
	JRST POPAJ


$ALLC0:	HRRZ A,(AR2A)
$ALLC5:	JUMPE A,TRUE		;DECODE LIST OF PAIRS
	HLRZ B,(A)		;ARG IS LIST OF SAME FORM AS
	HRRZ AR2A,(A)		; A .LISP. (INIT) COMMENT
	HLRZ C,(AR2A)
	CAIL B,QREGPDL
	CAILE B,QSPECPDL
	JRST $ALLC3
	MOVEI D,1←-1		;SSPDLMAX
	PUSHJ P,SSGP3$
	JRST $ALLC0

$ALLC3:	JSP R,SFRET
	 JRST $ALLC0
	 JRST $ALLC0
	SETZ AR1,
	MOVEI F,(C)
	SKOTT C,LS
	 JRST $ALLC2
	HRRZ AR1,(C)
	HLRZ C,(C)
	HLRZ F,(AR1)
	SKIPE AR1
	 SKIPA AR1,(AR1)
	  SKIPA F,C
	   HLRZ AR1,(AR1)
$ALLC2:	MOVEI D,3←-1		;SSGCSIZE
	PUSHJ P,SSGP3$
	MOVEI C,(F)
	MOVEI D,5←-1		;SSGCMAX
	PUSHJ P,SSGP3$
	MOVEI C,(AR1)
	MOVEI D,7←-1		;SSGCMIN
	PUSHJ P,SSGP3$
	JRST $ALLC0


	PGTOP BIB,[MEMORY MANAGEMENT STUFF]